unit Comtrak;

{

Created  12/29/98 by Ben Hull as a shared repository of Constants, Enumerated Types

TRecords, Procedures and Functions. Used throughout all Comtrak Applications.

Last Modified 12/19/2005 by Ben Hull

}

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  ExtCtrls, ToolWin, ComCtrls, StdCtrls, Db, DBTables, DBCtrls, Mask,

  Registry, BDE, Math, Printers, DBGrids, FileCtrl, Variants;

 

const

 //Event Action Type Constants

 EV_BEGIN = 1;

 EV_END = 2;

 EV_ARRIVE = 3;

 EV_DEPART = 4;

 EV_PICKUP = 5;

 EV_DROP = 6;

 EV_LOADING = 7;

 EV_UNLOADING = 8;

 EV_TRACTOR = 9;

 EV_EMPTY_TRL = 10;

 EV_LOADED_TRL = 11;

 EV_DETENTION = 12;

 EV_LAYOVER = 13;

 EV_SHIPPER = 14;

 EV_CONSIGNEE = 15;

 EV_STOPOFF = 16;

 EV_CHECKCALL = 17;

 EV_ROUTE_PT = 18;

 EV_DEADHEAD = 19;

 EV_BOBTAIL = 20;

 EV_OUT_OF_SVC = 22;

 EV_HOLD = 34;

 EV_SHUTTLE = 35;

 //Order Type Constants

 LOGISTICS_HUB = 0;

 LOGISTICS_OTHER = 1;

 PRENOTE = 2;

 CROSSTOWN = 3;

 SUBSERVICE = 4;

 DRAYAGE = 5;

 TRUCKLOAD = 6;

 REVENUE_ONLY = 7;

 NON_REVENUE = 8;

 MASTER_INTERMODAL = 9;

 //Line of Business Constants

 LOB_MEMPHIS = 0;

 LOB_RAILTRAK = 1;

 LOB_ROADTRAK = 2;

 LOB_ATLANTA = 3;

 LOGISTICS_BILLTO_ID=45273;//Account 8375

 //Carriage Return and Line Feed

 CrLf = #13#10;

 //Important City IDs

 MEMPHIS_TN = 79691;

 UNION_CITY_TN = 80575;

 NEW_JOHNSONVILLE_TN = 79843;

 MARION_AR = 3759;

 W_MEMPHIS_TN =  4538;

 OLIVE_BRANCH_MS = 46953;

 SOUTHAVEN_MS = 47244;

 HORN_LAKE_MS = 46575;

 ATLANTA_GA = 14387;

 AUSTELL_GA = 14399;

 FAIRBURN_GA = 15049;

 NASHVILLE_TN = 79819;

 CHATTANOOGA_TN = 78557;

 BIRMINGHAM_AL = 205;

 HUNTSVILLE_AL = 1123;

 DALLAS_TX = 81756;

 HOUSTON_TX = 82626;

 LA_PORTE_TX = 82901;

 SAVANNAH_GA = 16203;

 GARDEN_CITY_GA = 15148;

 N_CHARLESTON_SC = 76887;

 CHARLESTON_SC = 76314;

 MT_PLEASANT_SC = 76871;

 NORFOLK_VA = 88397;

 HASLET_TX = 82490;

 WILMER_TX = 85016;

 KANSAS_CITY_MO = 44391;

 KANSAS_CITY_KS = 26159;

 

type

 EInfotrakError = class(Exception);

 

 EDispatchError = class(EInfotrakError);

 EEMailError = class(EInfotrakError);

 EOrderEntryError = class(EInfotrakError);

 EInvoicingError = class(EInfotrakError);

 EAccountsReceivableError = class(EInfotrakError);

 ESafetyError = class(EInfotrakError);

 

type

 TOrderType = (otLogisticsHub, otLogisticsOther, otPreNote, otCrosstown,

  otSubService, otDrayage, otTruckload, otRevenueOnly, otEquipmentOrder, otMasterIntermodal);

 TAuditQuery = (aqLoads, aqCustomer, aqRates, aqTrailer, aqReceivables);

 TCustomerSearch = (csNumber, csCode, csName, csAbort, csLocationID, csGroupID, csGroupName);

 TNextID = (nidOrder, nidAccount, nidLocation, nidRate, nidStop, nidTariff,

  nidServiceException, nidDriver, nidTractor, nidEvent, nidTire_Control, nidVendor,

  nidTrailer, nidPayroll);

 TLateType = (ltDelivery, ltPickup, ltStopDelivery, ltStopPickup);

 TEventHistory = (ehDriver, ehTractor, ehTrailer, ehOrder);

 TGeoType = (geoCityState, geoState, geoZip, geoRadius, geoFail);

 TTracePick = (tpDriver, tpTerminal, tpTractor, tpTrailer, tpWho, tpChassis);

 TOrderUpdate = (ouTrailer, ouAssign, ouArrive, ouDispatch, ouArrStop, ouDepStop, ouDeliver,

    ouDrop, ouDepart, ouUnassign, ouPartial);

 TTrailerUpdate = (tuAssign, tuDispatch, tuDrop, tuTerminate, tuUnassign);

 TWorkLoad = (wlNone, wlDriver, wlLumper);

 TEDISequence = (ediIPUAP, ediIDLAP, ediOETA, ediCPUAP, ediAO, ediDO,

  ediS00ET, ediS00AP, ediAS00P, ediDS00P, ediAS00D, ediDS00D, ediDETA,

  ediCDLAP, ediAD, ediDD, ediV, ediER, ediDE, ediPE, ediLC, ediSPL, ediSDU,

  ediTE, ediDU);

 TMemoType = (mtFax, mtPrint, mtEmail);

 TCustType = (ctBillto, ctShipper, ctConsignee);

 TReceivableSearch = (rsInvoice, rsOrderID, rsTrailer, rsReference, rsReceivablesID, rsAmount);

 TInvoiceType = (itLoad, itAccessorial, itFine, itTire);

 TOriginTable = (otOrder, otOrder_History, otMisc_Invoice, otRebill, otManualInvoice);

 TProductivityType = (ptWhoEntered, ptWhoDispatched, ptWhoInvoiced);

 

 TCharacterField = string[20];

 TNameString = string[25];

 TValueString = string[80];

 TRecord_ID = string[12];

 TSmallField = string[2];

 TUserRec = record

   UserID : Integer;

   Login : TCharacterField;

   Company : Integer;

   First_Name : TCharacterField;

   Last_Name : TCharacterField;

   Title : TCharacterField;

   Password : TCharacterField;

   EMail : TCharacterField;

   Department : TCharacterField;

   Terminal : Integer;

   Initials : TSmallField;

   Security : TSmallField;

   Computer : Integer;

   Dispatch : Integer;

   Accounting : Integer;

   Safety : Integer;

   LOB : Integer;

end;

 

type

 TCityRec = record

  City_id : Integer;

  City    : TNameString;

  State   : TSmallfield;

  County  : TNameString;

  Zip     : TCharacterField;

  Lat     : TCharacterField;

  Long    : TCharacterField;

end;

 

type

 TTrailerRec = record

  Trailer_id : integer;

  Trailer : string;

  Chassis : string;

  Size : string;

  Terminal : integer;

  Desc : string;

end;

 

type

 TEventRec = record

  Action1 : Integer;

  Action2 : Integer;

  City_ID : Integer;

  Location_ID : Integer;

  Driver_ID : Integer;

  Order_ID : Integer;

  Tractor_ID : Integer;

  Trailer : string; //string[10] for trailer name

  Trailer_ID : Integer;

  Miles : Integer;

  Pay : string; //string[5] TRUE or FALSE

  Event_Time : TDateTime;

  Event_Date : TDateTime;

  Time_Code : string;//string[1] A for actual, E for estimated, R for reported

  Who_Entered : string;

  Time_Entered : TDateTime;

  Date_Entered : TDateTime;

  Comment : string;

end;

 

type

 TLatLongRange = record

   OriginLat : Double;

   OriginLong : Double;

   Radius : Integer;

   StartLat : Double;

   StartLong : Double;

   EndLat : Double;

   EndLong : Double;

end;

 

type

 TInvoiceRec = record

   Invoice_ID : Integer;

   Invoice_Num : Integer;

   Invoice_Type : Integer;

   Company : Integer;

   Terminal : Integer;

   Date_Entered : TDateTime;

   Who_Entered : String;

   Date_Changed : TDateTime;

   Who_Changed : String;

   Bto_Location_ID : Integer;

   Customer_Reference : String;

   Authorization : String;

   Order_ID : Integer;

   Trailer_ID : Integer;

   Trailer : String;

   Chassis : String;

   Driver_ID : Integer;

   Charge1_Desc : String;

   Charge1_Coeff : Double;

   Charge1_Rate : Double;

   Charge1_Amt : Double;

   Charge2_Desc : String;

   Charge2_Coeff : Double;

   Charge2_Rate : Double;

   Charge2_Amt : Double;

   Charge3_Desc : String;

   Charge3_Coeff : Double;

   Charge3_Rate : Double;

   Charge3_Amt : Double;

   Charge4_Desc : String;

   Charge4_Coeff : Double;

   Charge4_Rate : Double;

   Charge4_Amt : Double;

   Charge5_Desc : String;

   Charge5_Coeff : Double;

   Charge5_Rate : Double;

   Charge5_Amt : Double;

   Charge6_Desc : String;

   Charge6_Coeff : Double;

   Charge6_Rate : Double;

   Charge6_Amt : Double;

   Comment : String;

   Print_Date : TDateTime;

   Status : Integer;

   Est_Pay : Double;

   Total_Charge : Double;

   Begin_Timestamp : TDateTime;

   End_Timestamp : TDateTime;

   Rate_ID : Integer;

end;

 

type

 TMM_Ord_Trl_Rec = record

  Order_id : Integer;

  size : char;

  reload : char;

  railroad : char;

  region : char;

  free_days : char;

end;

 

type

 TInvoiceSearch = record

  Invoice : String;

  InvoiceType : TInvoiceType;

  OriginTable : TOriginTable;

  RecordID : String;

  BalanceDue : Boolean;

  Found : Boolean;

end;

 

type

 TAppProfile = record

   Name : String;

   SendEmailDir : String;

   BackupEmailDir : String;

   SendFaxDir : String;

   BackupFaxDir : String;

   ErrorLogDir : String;

   SystemMemo : String;

   HelpFileDir : String;

   ReportDir : String;

   MobilecommSendDir : String;

end;

 

procedure VisibleControlsToggle(Sender : array of TControl; IsVisible : Boolean);

procedure EnableControlsToggle(Sender : array of TControl; IsEnabled : Boolean);

procedure EnableGroupBox(Sender: TGroupBox);

procedure DisableGroupBox(Sender: TGroupBox);

procedure ModalPageControl(Sender: TForm;  Query: TQuery; ReadOnly: Boolean = False);

procedure RefreshQueries(Sender : array of TQuery);

procedure CloseQueries(Sender : array of TQuery);

procedure ValidateCurrency(Sender: TDBEdit);

procedure SyncDateTimes(Time1: TMaskEdit; Date1: TDateTimePicker; Time2: TMaskEdit; Date2: TDateTimePicker; DefaultTime: TDateTime; DefaultDate: TDateTime);

procedure GetFormPosition(Sender: TObject);

procedure SaveFormPosition(Sender: TObject);

function WhoAmI: string;

function CodeToText(Code_Type: string; Code: string; Database: TDatabase): string;

function TextToCode(Code_Type: string; Text: string; Database: TDatabase): string;

function CheckState(State: string; Database: TDatabase): Boolean;

procedure SetShortcutTime(CheckTime : string; var TimeEdit1: TMaskEdit;

  var TimeEdit2: TMaskEdit);

function ValidateTime(TimeEdit: TMaskEdit) : Boolean;

function Query(Select : string; Sender: TQuery; QueryClose: Boolean = False; Unique: Boolean = False): boolean;

function GetOrderType(Sender: TQuery): TOrderType;

function ConfirmChangesDialog(Sender: TQuery): Boolean;

function ShowModalPage(Sender : TForm): TModalResult;

function RunTimeQuery(Select : string; Database: TDatabase; Unique: Boolean = False): boolean;

function GetRecordID(Select : string; Database: TDatabase) : Integer;

function IsInteger(Arg : string) : Boolean;

function FormattedStr(arg : string; length : integer): string;

function NextBusinessDay : TDateTime;

function WeekEndingDate(aDate : TDateTime) : TDateTime;

function LastBusinessDay : TDateTime;

function PackTable(TabName: PChar): Boolean;

procedure ClearControls(Sender : TWinControl);

function BuildSQLLine(FieldName : String; FieldType : TFieldType; Sender : TEdit;

                   Date1 : TMaskEdit = nil; Date2 : TMaskEdit = nil; Op : String = '='): String;

procedure FillComboBox(Sender : TComboBox; CodeType : String; UseCode : Boolean; Database: TDatabase);

procedure DBFillComboBox(Sender : TComboBox; TableName : String; FieldName : String; Database: TDatabase);

procedure SQLCommand(CommandText : String; Database : TDatabase; Attempts : Integer = 2);

procedure PrintQueryResult(Query : TQuery; Title : String; TruncLine : Boolean = False);

procedure PrintDBGrid(DBGrid : TDBGrid; Query : TDataset; Title : String);

function DateTimeToSQLDate(Arg : TDateTime): String;

function DateTimeToSQLTimestamp(Arg : TDateTime): String;

function DateTimeToSQLTime(Arg : TDateTime): String;

function NowToSQLTimestamp : String;

function StrToSQL(Arg : String): String;

function IntToSQL(Arg : Integer): String;

function BooleanToSQL(Arg : Boolean) : String;

function FloatToSQL(Arg : Real) : String;

function CurrencyToSQL(Arg : Double) : String;

function GetDBString(Select : String; Database : TDatabase):String;

function GetDBDateTime(Select : String; Database : TDatabase) : TDateTime;

function GetDBFloat(Select : String; Database : TDatabase) : Real;

function GetDBBoolean(Select : String; Database : TDatabase) : Boolean;

//procedure SendEMail(EMailTo: String; EMailFrom: String; EMailSubj : String;

// The_Msg: String; IsUrgent: Boolean; ImportFile: String; Registered : Boolean = False;

// FileAttachment : String = '');

function SendEMail(EMailDir : String; EMailTo: String; EMailFrom: String; EMailSubj : String;

 The_Msg: String; IsUrgent: Boolean; ImportFile: String; Registered : Boolean = False;

 FileAttachment : String = '') : Boolean;

procedure SendFax(FileToFax: String; AskCopy: Boolean=True; DeleteSource : Boolean=True);

procedure bdeSQLInsert(TableName : String; Fields : Array of String; Values : Array of String;

                       Database : TDatabase);

procedure bdeSQLUpdate(TableName : String; Fields : Array of String; Values : Array of String;

                       KeyName : String; KeyValue : String; Database : TDatabase);

procedure bdeApplyUpdates(Queries : Array of TQuery; SilentException : Boolean; SendTo : String);

function IntegerToChar ( i : Integer) : Char;

function CreatePassword ( length : integer ): string;

function ShortDateStrToDateTime( Arg : String) : TDateTime;

procedure ExportDatasetToCSV(ExportData : TDataset; FileName : String; SetBlanksToNull : Boolean = True;

                             ShowTime : Boolean = False;

                             VisibleOnly : Boolean = False);

procedure ExportDatasetToXML(ExportData : TDataset; FileName : String);

procedure ExportDatasetToText(ExportData : TDataset; Filename : String);

function GetAppProfileFromDatabase(var AppProfile : TAppProfile; Database : TDatabase) : Boolean;

procedure GetAppProfileFromRegistry(var AppProfile : TAppProfile);

procedure SaveAppProfileToRegistry(const AppProfile : TAppProfile);

procedure WriteErrorLog(ErrorDir : String; User : String;

                        CallingClass : String; ErrorClass : String;

                        ErrorMsg : String);

procedure GetLatLongRange(var LatLongRange : TLatLongRange);

 

 

 

 

implementation

 

procedure VisibleControlsToggle(Sender : array of TControl; IsVisible : Boolean);

var

  C : Integer;

begin

  for C := 0 to High(Sender) do

   begin

    Sender[C].Visible := IsVisible;

   end;

end;

 

procedure EnableControlsToggle(Sender : array of TControl; IsEnabled : Boolean);

var

  C : Integer;

begin

  for C := 0 to High(Sender) do

   begin

    Sender[C].Enabled := IsEnabled;

   end;

end;

 

 

procedure EnableGroupBox(Sender: TGroupBox);

var

  C : Integer;

begin

  For C := 0 To Sender.ControlCount - 1 Do

    Sender.Controls[C].Enabled := True;

end;

 

procedure DisableGroupBox(Sender: TGroupBox);

var

  C : Integer;

begin

  For C := 0 To Sender.ControlCount - 1 Do

    Sender.Controls[C].Enabled := False;

end;

 

procedure ModalPageControl(Sender: TForm;  Query: TQuery; ReadOnly: Boolean = False);

begin

 if (Query <> nil) and

    (not ReadOnly) then

  Query.Edit;

 try

  if Sender.ShowModal = mrOK then

   begin

    if (Query <> nil) and

       (not ReadOnly) then

     if ((Query.Modified) or (Query.UpdatesPending)) then

      Query.ApplyUpdates;

   end

  else

   begin

    if (Query <> nil) and

       (not ReadOnly) then

     if ((Query.Modified) or (Query.UpdatesPending)) and

        (MessageDlg('Do you want to save your changes?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then

      Query.ApplyUpdates

     else

      Query.RevertRecord;

   end;

 finally

  Sender.Free;

 end;

end;

 

procedure RefreshQueries(Sender : array of TQuery);

var

  C : Integer;

begin

  for C := 0 to High(Sender) do

   begin

//    Sender[C].DisableControls;

    Sender[C].Close;

    Sender[C].Open;

//    Sender[C].EnableControls;

   end;

end;

 

procedure CloseQueries(Sender : array of TQuery);

var

  C : Integer;

begin

  for C := 0 to High(Sender) do

    Sender[C].Close;

end;

 

procedure ValidateCurrency(Sender: TDBEdit);

begin

  try

   Sender.Text := Format('%7f', [StrToFloat(Sender.Text)]);

  except

   on EConvertError do

    begin

     Sender.Text := '0.00';

     ShowMessage('You must enter a number between 0 and 9999.99');

     Sender.SetFocus;

    end;//on conversion error do..

  end;//try..except

end;//proc

 

procedure SyncDateTimes(Time1: TMaskEdit; Date1: TDateTimePicker; Time2: TMaskEdit; Date2: TDateTimePicker; DefaultTime: TDateTime; DefaultDate: TDateTime);

begin

 if (Trunc(DefaultDate) > 0) and (Trunc(Date1.Date) < Trunc(DefaultDate)) then Date1.Date := DefaultDate;

 if (DefaultTime > 0) and  (StrToTime(Time1.Text) < Frac(DefaultTime)) and (Trunc(Date1.Date) = Trunc(DefaultDate)) then

  Time1.Text := FormatDateTime('hh:mm', DefaultTime);

 if Trunc(Date2.Date) < Trunc(Date1.Date) then Date2.Date := Date1.Date;

 if (Trunc(Date2.Date) = Trunc(Date1.Date)) and

    (StrToTime(Time2.Text) < StrToTime(Time1.Text)) then Date2.Date := (Date2.Date + 1);

end;

 

procedure GetFormPosition(Sender: TObject);

var

 Registry : TRegistry;

 KeyName : String;

begin

 KeyName := 'Software\Delphi4\OrderEntry\'+(Sender as TForm).Name;

 Registry := TRegistry.Create;

 try

  if Registry.KeyExists(KeyName) then

   begin

    Registry.OpenKey(KeyName, False);

    (Sender as TForm).Top := Registry.ReadInteger('Top');

    (Sender as TForm).Left := Registry.ReadInteger('Left');

   end

 finally

  Registry.Free;

 end;

end;

 

procedure SaveFormPosition(Sender: TObject);

var

 Registry : TRegistry;

 KeyName : String;

begin

 KeyName := 'Software\Delphi4\OrderEntry\'+(Sender as TForm).Name;

 Registry := TRegistry.Create;

 try

  Registry.OpenKey(KeyName, True);

  Registry.WriteInteger('Top', (Sender as TForm).Top);

  Registry.WriteInteger('Left', (Sender as TForm).Left);

 finally

  Registry.Free;

 end;

end;

 

function WhoAmI: string;

var

 name : Array[0..64] of Char;

 login : DWord;

begin

 result := '';

 if GetUserName(name, login) then

  result := name;

end;

 

function CodeToText(Code_Type: string; Code: string; Database: TDatabase): string;

var

 Query: TQuery;

begin

 result := '';

 Query := TQuery.Create(nil);

 try

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := ('select code_text from code where type = '''+Code_Type+'''and code = '''+Code+'''');

  Query.Open;

  if Query.RecordCount = 1 then result := Query.FieldByName('CODE_TEXT').Value;

  Query.Close;

 finally

  Query.Free;

 end;

end;

 

 

function TextToCode(Code_Type: string; Text: string; Database: TDatabase): string;

var

 Query: TQuery;

begin

 result := '';

 Query := TQuery.Create(nil);

 try

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := ('select code from code where type = '''+Code_Type+'''and code_text = '''+Text+'''');

  Query.Open;

  if Query.RecordCount = 1 then result := Query.FieldByName('CODE').Value;

  Query.Close;

 finally

  Query.Free;

 end;

end;

 

function CheckState(State: string; Database: TDatabase): Boolean;

var

 Query: TQuery;

begin

 Query := TQuery.Create(nil);

 try

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := (('select * from state where state = '+AnsiQuotedStr(state, #39)));

  Query.Open;

  result := Query.RecordCount = 1;

  Query.Close;

 finally

  Query.Free;

 end;

end;

 

function Query(Select : string; Sender: TQuery; QueryClose: Boolean = False; Unique: Boolean = False): boolean;

begin

 with Sender do

  begin

   Close;

   SQL.Clear;

   SQL.Text := Select;

   Open;

   if Unique then result := RecordCount = 1

   else result := RecordCount <> 0;

  end;

   if QueryClose then Sender.Close;

end;

 

// This procedure sets a time range to the current time when one of the

// times in the range is set to 11:11, and sets the range to any time

// (00:01 - 23:59) when one of the times in the range is set to 01:24

procedure SetShortcutTime(CheckTime : string; var TimeEdit1: TMaskEdit;

  var TimeEdit2: TMaskEdit);

begin

  If (CheckTime <> '11:11') and (CheckTime <> '01:24') Then Exit;

  If CheckTime = '11:11' Then Begin

    TimeEdit1.Text := FormatDateTime('hh:nn', Now);

    TimeEdit2.Text := FormatDateTime('hh:nn', Now);

  End

  Else Begin //Checktime = '01:24'

    TimeEdit1.Text := '00:01';

    TimeEdit2.Text := '23:59';

  End;

end;

 

function ValidateTime(TimeEdit: TMaskEdit) : Boolean;

begin

  If Trim(TimeEdit.Text) <> ':' Then Begin

    Result := True;

    If Copy(TimeEdit.Text, 2, 1) = ' ' Then

      TimeEdit.Text := '0' + Copy(TimeEdit.Text, 1, 1) + ':00';

    TimeEdit.Text := StringReplace(TimeEdit.Text, ' ', '0', [rfReplaceAll]);

    If TimeEdit.Text = '00:00' Then TimeEdit.Text := ':';

    Try

      FormatDateTime('hh:nn', StrToTime(TimeEdit.Text));

    Except

      Result := False;

      MessageDlg('Invalid Time', mtError, [mbOK], 0);

      TimeEdit.SetFocus;

    End; //Try..Except

  End

  Else Result := False;

end;

 

function GetOrderType(Sender: TQuery): TOrderType;

begin

 case sender.FieldByName('ORDER_TYPE').Value of

  0: result := otLogisticsHub;

  1: result := otLogisticsOther;

  2: result := otPreNote;

  3: result := otCrosstown;

  4: result := otSubService;

  5: result := otDrayage;

  6: result := otTruckload;

  7: result := otRevenueOnly;

  8: result := otEquipmentOrder;

  9: result := otMasterIntermodal;

 else

  begin

   result := otRevenueOnly;

   MessageDlg('An error occurred finding the Order Type, this order will show Revenue Only, please contact the computer department', mtError, [mbOK], 0);

  end

 end;

end;

 

function ConfirmChangesDialog(Sender: TQuery): Boolean;

begin

 result := false;

 if (Sender.Modified) or (Sender.UpdatesPending) then

  begin

   case MessageDlg('Do you want to save your changes?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of

    mrYes : begin

      Sender.ApplyUpdates;

      result := true;

     end;

    mrNo : begin

      Sender.RevertRecord;

      result := true;

     end;

    mrCancel : result := false;

   end;//case

  end

 else

  result := true

end;

 

function ShowModalPage(Sender : TForm): TModalResult;

begin

 try

  Result := Sender.ShowModal;

 finally

  Sender.Free;

 end;

end;

 

function RunTimeQuery(Select : string; Database: TDatabase; Unique: Boolean = False): boolean;

var

 Query : TQuery;

begin

 Query := TQuery.Create(nil);

 try

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := Select;

  Query.Open;

  if Unique then result := Query.RecordCount = 1

  else result := Query.RecordCount > 0;

  Query.Close;

 finally

  Query.Free;

 end;

end;

 

function GetRecordID(Select : string; Database: TDatabase) : Integer;

var

 Query : TQuery;

begin

 Query := TQuery.Create(nil);

 try

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := Select;

  Query.Open;

  try

   result := Query.Fields[0].AsInteger;

  except

   on EConvertError do result := 0;

  end;

  Query.Close;

 finally

  Query.Free;

 end;

end;

 

function IsInteger(Arg : string) : Boolean;

begin

 result := true;

 try

  StrToInt(Arg);

 except

  on EConvertError do

   begin

//    MessageDlg(Arg+' is not a valid number', mtError, [mbOK], 0);

    result := false;

   end;//on..do

 end;//try..except

end;

 

function FormattedStr(arg : string; length : integer): string;

begin

 result := StringOfChar(' ', length);

 Insert(arg, result, 1);

 result := Copy(result, 1, length);

end;

 

function NextBusinessDay : TDateTime;

begin

 case DayOfWeek(Now) of

  1..5 : result := Now + 1;

  6 : result := Now + 3;

  7 : result := Now + 2;

 else

  result := Now;

 end;//case

end;

 

function LastBusinessDay : TDateTime;

begin

 case DayOfWeek(Now) of

  1 : result := Now - 2;

  2 : result := Now - 3;

  3..7 : result := Now - 1;

 else

  result := Now;

 end;//case

end;

 

function WeekEndingDate(aDate : TDateTime) : TDateTime;

begin

 result := aDate + (7 - DayOfWeek(aDate));

end;

 

//This will pack a *.dbf dBase table

function PackTable(TabName: PChar): Boolean;

var

  hDb       :hDBIDb;

  hCursor   :hDBICur;

  dbResult  :DBIResult;

begin

  {Initialize the BDE.}

  result := False;

  dbResult := DbiInit(nil);

  Check(dbResult)  ;

  {Open a Database.}

  dbResult := DbiOpenDatabase('','STANDARD',dbiREADONLY,dbiOPENSHARED,'',

                  0,nil,nil,hDB);

  try

    {Check raises an exception if the BDE call

     returns an error code other than DBIERR_NONE.

     The DBTables unit must be in the uses clause to use Check.

     In Delphi 2 this procedure is located in the DB unit.}

    Check(dbResult);

  except

    DbiExit;

  end;

  {Open a table. This returns a handle to the table's

  cursor, which is required by many of the BDE calls.}

  dbResult := DbiOpenTable(hDB, TabName, '','','',0,dbiREADWRITE,

               dbiOPENEXCL,xltNONE,False,nil,hCursor);

  try

    Check(dbResult);

  except

    DbiCloseDatabase(hDB);

    DbiExit;

  end;

  {The BDE is initialized, a database is open, and a cursor

  is open for a table. We can now work with the table.

  The following segment shows how to pack a dBASE or

  Paradox table. Note that before we can pack the Paradox

  table, the table's cursor handle must be closed, otherwise

  we would get a 'Table in use' error.}

  try

   {Packing a dBASE table is much easier.}

   dbResult := DbiPackTable(hDB, hCursor,'','',True);

   if dbResult = DBIERR_NONE then

    result := True;

  finally

    DbiCloseCursor(hCursor);

    DbiCloseDatabase(hDB);

    DbiExit;

  end;

end;

 

procedure ClearControls(Sender : TWinControl);

var

 c : integer;

begin

 for c := 0 to Sender.ControlCount - 1 do

  begin

   if Sender.Controls[c] is TEdit then

    (Sender.Controls[c] as TEdit).Text := '';

   if Sender.Controls[c] is TMaskEdit then

    (Sender.Controls[c] as TMaskEdit).Text := '';

   if Sender.Controls[c] is TComboBox then

    (Sender.Controls[c] as TComboBox).ItemIndex := -1;

  end;

end;

 

function BuildSQLLine(FieldName : String; FieldType : TFieldType; Sender : TEdit;

                   Date1 : TMaskEdit = nil; Date2 : TMaskEdit = nil; Op : String = '='): String;

var

 s : string;

 LowDate, HighDate : TDateTime;

begin

 result := '';

 s := Trim(Sender.Text);

 if (s='') and

    ((Date1<>nil) and (Trim(Date1.Text)='/  /')) then exit;

 if Pos('NOT NULL', s) > 0 then

  begin

   result := fieldname+' is not null';

   exit;

  end;

 if Pos('NULL', s) > 0 then

  begin

   result := fieldname+' is null';

   exit;

  end;

 case FieldType of

  ftString :

   begin

    if Pos('%', s) > 0 then op := ' like ';

    if Pos('*', s) > 0 then

     begin

      s := StringReplace(s, '*', '%', [rfReplaceAll, rfIgnoreCase]);

      op := ' like ';

     end;

    result := FieldName+op+QuotedStr(s);

   end;

  ftSmallInt,ftInteger,ftFloat :

   begin

    if Copy(s, 1, 2)='>=' then

     begin

      op := '>=';

      delete(s, 1, 2);

     end

    else

     if Copy(s, 1, 2)='<=' then

      begin

      op := '<=';

      delete(s, 1, 2);

      end

     else

      if Copy(s, 1, 1)='>' then

       begin

      op := '>';

      delete(s, 1, 1);

       end

      else

       if Copy(s, 1, 1)='<' then

        begin

         op := '<';

         delete(s, 1, 1);

        end;

    result := FieldName+op+s;

   end;

  ftDate, ftDateTime :

   begin

    {DB2 Datetime(timestamp) will require a date() typecast}

    if FieldType = ftDateTime then

     s := 'date('+FieldName+')'

    else

     s := FieldName;

    //Both edit controls must be maskedits with date mask (mm/dd/yyyy format)

    if (Date2 = nil) or

       ((Trim(Date1.Text) <> '/  /') and (Trim(Date1.Text) = '/  /')) or

       (Date1.Text=Date2.Text) then

     begin

      result := s+op+QuotedStr(Date1.Text);

     end;

    if Date1.Text <> Date2.Text then

     begin

      //This insures a result set even if user inadvertantly enters high then low dates

      //this does not raise an exception, so correcting in code is easist course of action

      HighDate := Max(StrToDate(Date1.Text), StrToDate(Date2.Text));

      LowDate := Min(StrToDate(Date1.Text), StrToDate(Date2.Text));

      result := s+' between '+QuotedStr(FormatDateTime('mm/dd/yyyy', LowDate))

                +' and '+QuotedStr(FormatDateTime('mm/dd/yyyy', HighDate));

     end;

   end;

 end;//case

end;

{This fills a combobox from the code table with either the code or the code_text}

procedure FillComboBox(Sender : TComboBox; CodeType : String; UseCode : Boolean; Database: TDatabase);

var

 Query : TQuery;

 //Code table has 6 fields [code_id, type, code, code_text, description]

 FieldIndex : integer;

begin

 if UseCode then FieldIndex := 2 else FieldIndex := 3;

 Query := TQuery.Create(nil);

 try

  if not Database.Connected then Database.Open;

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := 'select * from code where type='''+CodeType+''' order by code ';

  Query.Open;

  Sender.Items.Clear;

  while not Query.EoF do

   begin

    Sender.Items.Add(Query.Fields[FieldIndex].AsString);

    Query.Next;

   end;

  Sender.ItemIndex := -1;

 finally

  Query.Free;

 end;

end;

 

procedure DBFillComboBox(Sender : TComboBox; TableName : String; FieldName : String; Database: TDatabase);

var

 Query : TQuery;

begin

 Query := TQuery.Create(nil);

 try

  if not Database.Connected then Database.Open;

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := 'select '+FieldName+' from '+TableName+' order by '+FieldName;

  Query.Open;

  Sender.Items.Clear;

  while not Query.EoF do

   begin

    Sender.Items.Add(Query.Fields[0].AsString);

    Query.Next;

   end;

  Sender.ItemIndex := -1;

 finally

  Query.Free;

 end;

end;

 

procedure SQLCommand(CommandText : String; Database : TDatabase; Attempts : Integer = 2);

var

 SQLCmd : TQuery;

 i : integer;

 CommandOK : Boolean;

begin

 i := 0;

 CommandOK := True;

 SQLCmd := TQuery.Create(nil);

 try

  SQLCmd.DatabaseName := Database.DatabaseName;

  repeat

  Inc(i);

  SQLCmd.SQL.Text := CommandText;

  try

   SQLCmd.ExecSQL;

   if not CommandOK then CommandOK := True;

  except

   on e: Exception do

    if Pos('Function sequence error', E.Message) = 0 then

     begin

      Sleep(1000);

      CommandOK := False;

      if i > Attempts then raise;

     end;

  end;

  until CommandOK;

 finally

  SQLCmd.Free

 end;

end;

 

procedure PrintQueryResult(Query : TQuery; Title : String; TruncLine : Boolean);

var

 P : TextFile;

 i, c, width : integer;

 s1, s2, FieldName : string;

begin

 AssignPrn(P);

 Rewrite(P);

 Printer.Canvas.Font.Pitch := fpFixed;

 Printer.Canvas.Font.Size := 10;

 Writeln(P, Title+' '+FormatDateTime('mm/dd/yy hh:mm', Now));

 //Write the Column Header

 s1 := '';

 s2 := '';

 for i := 0 to Query.FieldCount - 1 do

  begin

   if Query.Fields[i].Visible then

    begin

     FieldName := Query.Fields[i].DisplayName;

     width := Query.Fields[i].DisplayWidth;

     s1 := s1+FormattedStr(FieldName, width)+' ';

     for c := 1 to width do s2 := s2+'-';

     s2 := s2+' ';

    end;

  end;

 Writeln(P, s1);

 Writeln(P, s2);

 //End writing column headers

 Query.First;

 while not Query.Eof do

  begin

   s1 := '';

   for i := 0 to Query.FieldCount - 1 do

    begin

     if Query.Fields[i].Visible then

      begin

//       FieldName := Query.Fields[i].AsString;

       FieldName := Query.Fields[i].DisplayText;

       width := Query.Fields[i].DisplayWidth;

       if (TruncLine) and

          ((Length(s1) + width) > 80) then

        Break;

       s1 := s1+FormattedStr(FieldName, width)+' ';

      end;

    end;

   Writeln(P, s1);

   Query.Next;

  end;

 CloseFile(P);

end;

 

procedure PrintDBGrid(DBGrid : TDBGrid; Query : TDataSet; Title : String);

var

 P : TextFile;

 i, c, width : integer;

 s1, s2, FieldName : string;

begin

 AssignPrn(P);

 Rewrite(P);

 Printer.Canvas.Font.Pitch := fpFixed;

 Printer.Canvas.Font.Size := 10;

 Writeln(P, Title+' '+FormatDateTime('mm/dd/yy hh:mm', Now));

 //Write the Column Header

 s1 := '';

 s2 := '';

 for i := 0 to DBGrid.Columns.Count - 1 do

  begin

   FieldName := DBGrid.Columns[i].Title.Caption;

   width := Query.FieldByName(DBGrid.Columns[i].FieldName).DisplayWidth;

   s1 := s1+FormattedStr(FieldName, width)+' ';

   for c := 1 to width do s2 := s2+'-';

   s2 := s2+' ';

  end;

 Writeln(P, s1);

 Writeln(P, s2);

 //End writing column headers

 Query.First;

 while not Query.Eof do

  begin

   s1 := '';

   for i := 0 to DBGrid.Columns.Count - 1 do

    begin

//     FieldName := Query.FieldByName(DBGrid.Columns[i].FieldName).AsString;

     FieldName := Query.FieldByName(DBGrid.Columns[i].FieldName).DisplayText;

     width := Query.FieldByName(DBGrid.Columns[i].FieldName).DisplayWidth;

     s1 := s1+FormattedStr(FieldName, width)+' ';

    end;

   Writeln(P, s1);

   Query.Next;

  end;

 CloseFile(P);

end;

 

function DateTimeToSQLDate(Arg : TDateTime): String;

begin

 result := FormatDateTime('mm-dd-yyyy', Arg);

 if result = '12-30-1899' then

  result := 'null'

 else

  result := QuotedStr(result);

end;

 

function DateTimeToSQLTimestamp(Arg : TDateTime): String;

begin

 result := FormatDateTime('mm-dd-yyyy', Arg);

 if result = '12-30-1899' then

  result := 'null'

 else

  result := 'timestamp('

            +QuotedStr(FormatDateTime('mm-dd-yyyy', Arg))+', '

            +QuotedStr(FormatDateTime('hh:mm', Arg))+')';

end;

 

function DateTimeToSQLTime(Arg : TDateTime): String;

begin

 if Arg = 0 then

  result := 'null'

 else

  begin

   result := FormatDateTime('hh:mm', Arg);

   if result = '24:00' then result := '23:59';

   if result = '00:00' then result := '00:01';

   result := QuotedStr(result);

  end;

end;

 

function NowToSQLTimestamp : String;

begin

 result := 'timestamp(current date, current time)';

end;

 

function StrToSQL(Arg : String): String;

begin

 if Pos('''', Arg)>0 then

  result := StringReplace(Arg, '''', '', [rfReplaceAll]);

 if Pos('`', Arg)>0 then

  result := StringReplace(Arg, '`', '', [rfReplaceAll]);

 result := Trim(Arg);

 if result = '' then

  result := 'null'

 else

  result := QuotedStr(result);

end;

 

function IntToSQL(Arg : Integer): String;

begin

 if Arg = 0 then

  result := 'null'

 else

  result := IntToStr(Arg);

end;

 

function FloatToSQL(Arg : Real) : String;

begin

 if Arg = 0 then

  result := 'null'

 else

  result := FloatToStr(Arg);

end;

 

function CurrencyToSQL(Arg : Double) : String;

begin

 if Arg = 0 then

  result := 'null'

 else

  result := Format('%9f', [Arg]);

end;

 

function BooleanToSQL(Arg : Boolean) : String;

begin

 if Arg then result := QuotedStr('TRUE') else result := QuotedStr('FALSE');

end;

 

function GetDBString(Select : String; Database : TDatabase):String;

var

 Lookup : TQuery;

begin

 Lookup := TQuery.Create(nil);

 try

  Lookup.DatabaseName := Database.DatabaseName;

  Lookup.SQL.Text := Select;

  Lookup.Open;

  result := Lookup.Fields[0].AsString;

  Lookup.Close;

 finally

  Lookup.Free;

 end;

end;

 

function GetDBDateTime(Select : String; Database : TDatabase) : TDateTime;

var

 Lookup : TQuery;

begin

 Lookup := TQuery.Create(nil);

 try

  Lookup.DatabaseName := Database.DatabaseName;

  Lookup.SQL.Text := Select;

  Lookup.Open;

  result := Lookup.Fields[0].AsDateTime;

  Lookup.Close;

 finally

  Lookup.Free;

 end;

end;

 

function GetDBFloat(Select : String; Database : TDatabase) : Real;

var

 Lookup : TQuery;

begin

 Lookup := TQuery.Create(nil);

 try

  Lookup.DatabaseName := Database.DatabaseName;

  Lookup.SQL.Text := Select;

  Lookup.Open;

  result := Lookup.Fields[0].AsFloat;

  Lookup.Close;

 finally

  Lookup.Free;

 end;

end;

 

function GetDBBoolean(Select : String; Database : TDatabase) : Boolean;

var

 Lookup : TQuery;

begin

 Lookup := TQuery.Create(nil);

 try

  Lookup.DatabaseName := Database.DatabaseName;

  Lookup.SQL.Text := Select;

  Lookup.Open;

  result := Lookup.Fields[0].AsBoolean;

  Lookup.Close;

 finally

  Lookup.Free;

 end;

end;

{

procedure SendEMail(EMailTo: String; EMailFrom: String; EMailSubj : String;

 The_Msg: String; IsUrgent: Boolean; ImportFile: String;

 Registered : Boolean = False; FileAttachment : String = '');

var

 EMail, F2 : TextFile;

 Stamp : TTimeStamp;

 Name, SendPath, Line  : String;

begin

 EMailTo := Trim(EMailTo);

 if Pos('@', EMailTo) = 0 then

  begin

    if Pos('.', EMailTo)>0 then

     EMailTo := Trim(EMailTo)+'@COMTRAKINC.COM'

    else

     EMailTo := Trim(EMailTo)+'@COMTRAK';

  end;

 EMailFrom := Trim(EMailFrom);

 if Pos('@', EMailFrom) = 0 then

  begin

    if Pos('.', EMailFrom)>0 then

     EMailFrom := Trim(EMailFrom)+'@COMTRAKINC.COM'

    else

     EMailFrom := Trim(EMailFrom)+'@COMTRAK';

  end;

 repeat

  stamp := DateTimeToTimeStamp(Now);

  SendPath := '\\APPS\apps_d\Mail\Send\';

  if not DirectoryExists(SendPath) then

   SendPath := '\\Memp-fs01\Mail\send\';

  Name := SendPath+IntToStr(Stamp.Time)

 until (not FileExists(Name)) and

       (not FileExists(Name+'.hld'));

 AssignFile(EMail, Name+'.hld');

 Rewrite(EMail);

 Writeln(EMail, 'SMF-70');

 Writeln(EMail, 'To: '   + EMailTo);

 Writeln(EMail,'From: ' + EMailFrom);

 if IsUrgent then Writeln(EMail,'Importance: HIGH');

 Writeln(EMail,'Subject: ' + EMailSubj);

 if Registered then Writeln(EMail, '20MCB-options: NYYNAYA');

//Attachment: <path>

 if FileAttachment <> '' then

  begin

   CopyFile(PChar(FileAttachment), PChar(SendPath+ExtractFileName(FileAttachment)), FALSE);

   Writeln(EMail, 'Attachment: '+ExtractFileName(FileAttachment));

  end;

 Writeln(EMail, '');

 Writeln(EMail,The_Msg);

 if (ImportFile <> '') and (FileExists(ImportFile)) then

  begin

   Append(EMail);

   AssignFile(F2, ImportFile);

   Reset(F2);

   while not Eof(F2) do

    begin

     Readln(F2, Line);

     Writeln(EMail, Line);

    end;

    CloseFile(F2);

  end;

 CloseFile(EMail);

 RenameFile(Name+'.hld', Name);

end;

}

function SendEMail(EMailDir : String; EMailTo: String; EMailFrom: String; EMailSubj : String;

 The_Msg: String; IsUrgent: Boolean; ImportFile: String; Registered : Boolean = False;

 FileAttachment : String = '') : Boolean;

var

 EMail, F2 : TextFile;

 Stamp : TTimeStamp;

 Name, SendPath, Line  : String;

begin

 EMailDir := Trim(EMailDir);

 EMailTo := Trim(EMailTo);

 EMailFrom := Trim(EMailFrom);

 if (EmailDir = '') or

    (not DirectoryExists(EMailDir)) or

    (EmailTo = '') or

    (EMailFrom = '') then

  begin

   Result := False;

   Exit;

  end;

 if Pos('@', EMailTo) = 0 then

  begin

    if Pos('.', EMailTo)>0 then

     EMailTo := Trim(EMailTo)+'@COMTRAKINC.COM'

    else

     EMailTo := Trim(EMailTo)+'@COMTRAK';

  end;

 EMailFrom := Trim(EMailFrom);

 if Pos('@', EMailFrom) = 0 then

  begin

    if Pos('.', EMailFrom)>0 then

     EMailFrom := Trim(EMailFrom)+'@COMTRAKINC.COM'

    else

     EMailFrom := Trim(EMailFrom)+'@COMTRAK';

  end;

 repeat

  stamp := DateTimeToTimeStamp(Now);

  Name := EMailDir+IntToStr(Stamp.Time)

 until (not FileExists(Name)) and

       (not FileExists(Name+'.hld'));

 AssignFile(EMail, Name+'.hld');

 Rewrite(EMail);

 Writeln(EMail, 'SMF-70');

 Writeln(EMail, 'To: '   + EMailTo);

 Writeln(EMail,'From: ' + EMailFrom);

 if IsUrgent then Writeln(EMail,'Importance: HIGH');

 Writeln(EMail,'Subject: ' + EMailSubj);

 if Registered then Writeln(EMail, '20MCB-options: NYYNAYA');

//Attachment: <path>

 if FileAttachment <> '' then

  begin

   CopyFile(PChar(FileAttachment), PChar(SendPath+ExtractFileName(FileAttachment)), FALSE);

   Writeln(EMail, 'Attachment: '+ExtractFileName(FileAttachment));

  end;

 Writeln(EMail, '');

 Writeln(EMail,The_Msg);

 if (ImportFile <> '') and (FileExists(ImportFile)) then

  begin

   Append(EMail);

   AssignFile(F2, ImportFile);

   Reset(F2);

   while not Eof(F2) do

    begin

     Readln(F2, Line);

     Writeln(EMail, Line);

    end;

    CloseFile(F2);

  end;

 CloseFile(EMail);

 RenameFile(Name+'.hld', Name);

 Result := True;

end;

 

 

procedure SendFax(FileToFax: String; AskCopy: Boolean=True; DeleteSource : Boolean=True);

//Step 1 Get Customer Info with Customer R_Numb Parameter

//Step 2 Create File

//Step 3 Build Standard Fax header

//Step 4 Add text from source file

var

 Line, Name : String;

 FileCopy, FaxCopy, Source : TextFile;

 PrintDlg : TPrintDialog;

 Stamp : TTimeStamp;

begin

 if fileExists(FileToFax) then

  begin

   repeat

    stamp := DateTimeToTimeStamp(Now);

    Name := '\\APPS\Apps_d\FAX\'+IntToStr(Stamp.Time);

   until not FileExists(Name);

  AssignFile(FaxCopy, Name);

  Rewrite(FaxCopy);

  AssignFile(Source, FileToFax);

  Reset(Source);

  while not EoF(Source) do

   begin

    Readln(Source, Line);

    Writeln(FaxCopy, Line);

   end;

  CloseFile(FaxCopy);

  Rename(FaxCopy, Name+'.FAX');

  PrintDlg := TPrintDialog.Create(nil);

  try

   if (AskCopy) and

      (MessageDlg('Do you want a file copy?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) and

      (PrintDlg.Execute) then

    begin

     Printer.Canvas.Font.Size := 12;

     AssignPrn(FileCopy);

     Rewrite(FileCopy);

     Reset(Source);

     while not EoF(Source) do

      begin

       Readln(Source, Line);

       Writeln(FileCopy, Line);

      end;

     Writeln(FileCopy, ' ');

     Writeln(FileCopy, ' FILE COPY ');

     CloseFile(FileCopy);

     CloseFile(Source);

    end;

   finally

    PrintDlg.Free;

   end;

 end;

 if DeleteSource and FileExists(FileToFax) then DeleteFile(FileToFax);

end;

 

procedure bdeSQLInsert(TableName : String; Fields : Array of String; Values : Array of String;

                       Database : TDatabase);

var

 i : integer;

 s : string;

begin

 s := 'insert into '+TableName;

 if Fields[0] <> '' then

  begin

   s := s+'(';

   for i := 0 to High(Fields) do

    begin

     s := s+Fields[i];

     if i <> High(Fields) then s := s+',';

    end;

   s := s+')';

  end;

 s := s+' values(';

 for i := 0 to High(Values) do

  begin

   s := s+Values[i];

   if i <> High(Values) then s := s+',';

  end;

 s := s+')';

 SQLCommand(s, Database);

end;

 

procedure bdeSQLUpdate(TableName : String; Fields : Array of String; Values : Array of String;

                       KeyName : String; KeyValue : String; Database : TDatabase);

var

 i : integer;

 s : string;

begin

 s := 'update '+TableName+' set ';

 for i := 0 to High(Fields) do

  begin

   s := s+Fields[i]+'='+Values[i];

   if i <> High(Fields) then s := s+' , ';

  end;

 s := s+' where '+KeyName+'='+KeyValue;

 SQLCommand(s, Database);

end;

 

procedure bdeApplyUpdates(Queries : Array of TQuery; SilentException : Boolean; SendTo : String);

var

 i : integer;

begin

 for i := 0 to High(Queries) do

  begin

   try

    if Queries[i].Modified or Queries[i].UpdatesPending then Queries[i].ApplyUpdates;

   except

    on E : Exception do

     begin

      SendEMail('\\APPS\APPS_D\Mail\Send\', SendTo, 'SYSTEM', 'BDE Apply Updates Error', E.Message+#13#10+Queries[i].SQL.Text, True, '');

      if not SilentException then raise;

     end;

   end

  end;

end;

 

function IntegerToChar ( i : Integer) : Char;

begin

 case i of

  0 : result := 'A';

  1 : result := 'B';

  2 : result := 'C';

  3 : result := 'D';

  4 : result := 'E';

  5 : result := 'F';

  6 : result := 'G';

  7 : result := '*';

  8 : result := 'H';

  9 : result := 'J';

  10 : result := 'K';

  11 : result := 'L';

  12 : result := 'M';

  13 : result := '?';

  14 : result := 'N';

  15 : result := 'P';

  16 : result := 'Q';

  17 : result := 'R';

  18 : result := 'S';

  19 : result := 'T';

  20 : result := 'U';

  21 : result := 'V';

  22 : result := 'W';

  23 : result := 'X';

  24 : result := 'Y';

  25 : result := 'Z';

  26 : result := 'a';

  27 : result := 'b';

  28 : result := 'c';

  29 : result := 'd';

  30 : result := 'e';

  31 : result := 'f';

  32 : result := 'g';

  33 : result := 'h';

  34 : result := 'i';

  35 : result := 'j';

  36 : result := '>';

  37 : result := 'k';

  38 : result := 'm';

  39 : result := 'n';

  40 : result := '^';

  41 : result := 'p';

  42 : result := 'q';

  43 : result := 'r';

  44 : result := 's';

  45 : result := 't';

  46 : result := 'u';

  47 : result := 'v';

  48 : result := 'w';

  49 : result := 'x';

  50 : result := 'y';

  51 : result := 'z';

  52 : result := '1';

  53 : result := '2';

  54 : result := '3';

  55 : result := '4';

  56 : result := '5';

  57 : result := '6';

  58 : result := '7';

  59 : result := '8';

  60 : result := '<';

  61 : result := '9';

 else

  result := '!';

 end;

end;

 

function CreatePassword ( length : integer ): string;

var

 c, WildCard : integer;

begin

 Randomize;

 result := StringOfChar(' ', length);

 for c := 1 to length do

  begin

   WildCard := Random(62);

   result[c] := IntegerToChar(WildCard);

  end;

end;

 

//ShortDate Format is mm/dd

function ShortDateStrToDateTime( Arg : String) : TDateTime;

var

 MonthStr, DayStr : String;

 CurDate : TDateTime;

 CurYear, CurMonth, CurDay, ArgDay, ArgMonth, ArgYear : Word;

begin

 if Copy(Arg, 1, 1) = '0' then

  MonthStr := Copy(Arg, 2, 1)

 else

  MonthStr := Copy(Arg, 1, 2);

 if Copy(Arg, 4, 1) = '0' then

  DayStr := Copy(Arg, 5, 1)

 else

  DayStr := Copy(Arg, 4, 2);

 ArgMonth := StrToInt(MonthStr);

 ArgDay := StrToInt(DayStr);

 CurDate := Now;

 DecodeDate(CurDate, CurYear, CurMonth, CurDay);

 if ArgMonth > CurMonth then

  ArgYear := CurYear - 1

 else

  ArgYear := CurYear;

 Result := EncodeDate(ArgYear, ArgMonth, ArgDay);

end;

 

procedure ExportDatasetToCSV(ExportData : TDataset; FileName : String;

                             SetBlanksToNull : Boolean = True;

                             ShowTime : Boolean = False;

                             VisibleOnly : Boolean = False);

var

 f : Textfile;

 Row, FieldData : String;

 i : integer;

begin

 AssignFile(f, FileName);

 Rewrite(f);

 ExportData.First;

 for i := 0 to ExportData.FieldCount - 1 do

  begin

   if VisibleOnly then

    begin

     if ExportData.Fields[i].Visible then

      begin

       Row := Row + ExportData.Fields[i].FieldName;

       if i <> ExportData.FieldCount - 1 then

       Row := Row+',';

      end;

    end

   else

    begin

     Row := Row + ExportData.Fields[i].FieldName;

     if i <> ExportData.FieldCount - 1 then

     Row := Row+',';

    end;

  end;

 Writeln(f, row);

 row :='';

 with ExportData do

  begin

   while not Eof do

    begin

     for i := 0 to FieldCount -1 do

      begin

         case Fields[i].DataType of

          ftSmallint, ftInteger : FieldData := Fields[i].AsString;

          ftFloat : FieldData := Trim(Format('%8f', [Fields[i].AsFloat]));

          ftDate :

           begin

            if Fields[i].Value <> Null then

             FieldData := FormatDateTime('mm/dd/yy', Fields[i].AsDateTime)

            else

             FieldData := '';

           end;

          ftTime : FieldData := FormatDateTime('hh:mm', Fields[i].AsDateTime);

          ftDateTime :

           begin

            if Fields[i].Value <> Null then

             begin

              if ShowTime then

               FieldData := FormatDateTime('mm/dd/yy hh:mm', Fields[i].AsDateTime)

              else

               FieldData := FormatDateTime('mm/dd/yy', Fields[i].AsDateTime)

             end

            else

             FieldData := '';

           end;

          ftLargeint : FieldData := Fields[i].AsString;

         else

          begin

           FieldData := StringReplace(Fields[i].AsString, '&', 'AND', [rfReplaceAll]);

           FieldData := StringReplace(FieldData, '"', ' ', [rfReplaceAll]);

           FieldData := StringReplace(FieldData, '''', ' ', [rfReplaceAll]);

           FieldData := StringReplace(FieldData, ',', ' ', [rfReplaceAll]);

          end;

         end;

         if (SetBlanksToNull) and (FieldData = '') then FieldData := 'NULL';

         if VisibleOnly then

          begin

           if Fields[i].Visible then

            begin

             Row := Row+FieldData;

             if i <> FieldCount - 1 then

              Row := Row+',';

            end

          end

         else

          begin

           Row := Row+FieldData;

           if i <> FieldCount - 1 then

            Row := Row+',';

          end;

      end;

     Writeln(f, row);

     row := '';

     Next;

    end;

  end;

  CloseFile(f);

end;

 

procedure ExportDatasetToXML(ExportData : TDataset; FileName : String);

var

 f : Textfile;

 Row, FieldData : String;

 i : integer;

begin

 AssignFile(f, FileName);

 Rewrite(f);

 Writeln(f,'<DATAPACKET version="2.0">');

 Writeln(f,'<METADATA>');

 Writeln(f,'<FIELDS>');

 ExportData.First;

 for i := 0 to ExportData.FieldCount - 1 do

   begin

     Row := '<FIELD attrname="'+ExportData.Fields[i].FieldName+'" ';

     {

     TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,

     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,

     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,

     ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,

     ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,

     ftVariant, ftInterface, ftIDispatch, ftGuid);

     }

     case ExportData.Fields[i].DataType of

       ftString   :  row := row + 'fieldtype="string" WIDTH="'+IntToStr(ExportData.Fields[i].Size)+'"/>';

       ftSmallint,

       ftInteger  : row := row + 'fieldtype="i'+IntToStr(ExportData.Fields[i].DataSize)+'"/>';

       ftFloat    : row := row + 'fieldtype="r'+IntToStr(ExportData.Fields[i].DataSize)+'"/>';

       ftDate     : row := row + 'fieldtype="date"/>';

       ftTime     : row := row + 'fieldtype="time"/>';

       ftDateTime : row := row + 'fieldtype="datetime"/>';

       ftLargeint : row := row + 'fieldtype="i'+IntToStr(ExportData.Fields[i].DataSize)+'"/>';

     end;

     Writeln(f, row);

   end;

   Writeln(f,'</FIELDS>');

   Writeln(f,'</METADATA>');

   Writeln(f, '<ROWDATA>');

   with ExportData do

     begin

       while not Eof do

         begin

           Row := '<ROW ';

           for i := 0 to FieldCount -1 do

             begin

               if Fields[i].AsVariant <> Null then

                 begin

                   FieldData := StringReplace(Fields[i].AsString, '&', 'AND', [rfReplaceAll]);

                   FieldData := StringReplace(FieldData, '"', ' ', [rfReplaceAll]);

                   FieldData := StringReplace(FieldData, '''', ' ', [rfReplaceAll]);

                   Row := Row + ' ' + Fields[i].FieldName +'="'+FieldData+'" ';

                 end;

             end;

           Row := Row+'/>';

           Writeln(f, row);

           Next;

         end;

     end;

   Writeln(f, '</ROWDATA>');

   Writeln(f, '</DATAPACKET>');

   CloseFile(f);

end;

 

procedure ExportDatasetToText(ExportData : TDataset; Filename : String);

var

 f : TextFile;

 i,c, width : integer;

 s1, s2, FieldName : string;

begin

 //Write the Column Header

 AssignFile(f, FileName);

 Rewrite(f);

 ExportData.First;

 s1 := '';

 s2 := '';

 for i := 0 to ExportData.FieldCount - 1 do

  begin

   if ExportData.Fields[i].Visible then

    begin

     FieldName := ExportData.Fields[i].DisplayName;

     width := ExportData.Fields[i].DisplayWidth;

     s1 := s1+FormattedStr(FieldName, width)+' ';

     for c := 1 to width do s2 := s2+'-';

     s2 := s2+' ';

    end;

  end;

 Writeln(f, s1);

 Writeln(f, s2);

 //End writing column headers

 ExportData.First;

 while not ExportData.Eof do

  begin

   s1 := '';

   for i := 0 to ExportData.FieldCount - 1 do

    begin

     if ExportData.Fields[i].Visible then

      begin

//       FieldName := ExportData.Fields[i].AsString;

       FieldName := ExportData.Fields[i].DisplayText;

       width := ExportData.Fields[i].DisplayWidth;

       s1 := s1+FormattedStr(FieldName, width)+' ';

      end;

    end;

   Writeln(f, s1);

   ExportData.Next;

  end;

 CloseFile(f);

end;

 

function GetAppProfileFromDatabase(var AppProfile : TAppProfile; Database : TDatabase) : Boolean;

var

 Query : TQuery;

begin

 result := False;

 Query := TQuery.Create(nil);

 try

  Query.DatabaseName := Database.DatabaseName;

  Query.SQL.Text := 'select * from application_profile where application_name=:NAME';

  Query.Params[0].Value := AppProfile.Name;

  try

   Query.Open;

   if Query.RecordCount = 1 then

    begin

     result := True;

     AppProfile.SendEmailDir := Query.FieldByName('SendEmailDir').AsString;

     AppProfile.BackupEmailDir := Query.FieldByName('BackupEmailDir').AsString;

     AppProfile.SendFaxDir := Query.FieldByName('SendFaxDir').AsString;

     AppProfile.BackupFaxDir := Query.FieldByName('BackupFaxDir').AsString;

     AppProfile.ErrorLogDir := Query.FieldByName('ErrorLogDir').AsString;

     AppProfile.SystemMemo := Query.FieldByName('SystemMemo').AsString;

     AppProfile.HelpFileDir := Query.FieldByName('HelpFileDir').AsString;

     AppProfile.ReportDir := Query.FieldByName('ReportDir').AsString;

     AppProfile.MobilecommSendDir := Query.FieldByName('MobilecommSendDir').AsString;

    end;

  except

  end;

 finally

  Query.Free;

 end;//finally

end;

//HKEY_CURRENT_USER\

procedure GetAppProfileFromRegistry(var AppProfile : TAppProfile);

var

 Registry : TRegistry;

 KeyName : String;

begin

 KeyName := 'Software\AppProfile\'+AppProfile.Name;

 Registry := TRegistry.Create;

 try

  if Registry.KeyExists(KeyName) then

   begin

    Registry.OpenKey(KeyName, False);

    AppProfile.SendEmailDir := Registry.ReadString('SendEmailDir');

    AppProfile.BackupEmailDir := Registry.ReadString('BackupEmailDir');

    AppProfile.SendFaxDir := Registry.ReadString('SendFaxDir');

    AppProfile.BackupFaxDir := Registry.ReadString('BackupFaxDir');

    AppProfile.ErrorLogDir := Registry.ReadString('ErrorLogDir');

    AppProfile.SystemMemo := Registry.ReadString('SystemMemo');

    AppProfile.HelpFileDir := Registry.ReadString('HelpFileDir');

    AppProfile.ReportDir := Registry.ReadString('ReportDir');

    AppProfile.MobilecommSendDir := Registry.ReadString('MobilecommSendDir');

   end

 finally

  Registry.Free;

 end;

end;

//HKEY_CURRENT_USER\

procedure SaveAppProfileToRegistry(const AppProfile : TAppProfile);

var

 Registry : TRegistry;

 KeyName : String;

begin

 KeyName := 'Software\AppProfile\'+AppProfile.Name;

 Registry := TRegistry.Create;

 try

  Registry.OpenKey(KeyName, True);

  Registry.WriteString('SendEmailDir', AppProfile.SendEmailDir);

  Registry.WriteString('BackupEmailDir', AppProfile.BackupEmailDir);

  Registry.WriteString('SendFaxDir', AppProfile.SendFaxDir);

  Registry.WriteString('BackupFaxDir', AppProfile.BackupFaxDir);

  Registry.WriteString('ErrorLogDir', AppProfile.ErrorLogDir);

  Registry.WriteString('SystemMemo', AppProfile.SystemMemo);

  Registry.WriteString('HelpFileDir', AppProfile.HelpFileDir);

  Registry.WriteString('ReportDir', AppProfile.ReportDir);

  Registry.WriteString('MobileCommSendDir', AppProfile.MobilecommSendDir);

 finally

  Registry.Free;

 end;

end;

 

procedure WriteErrorLog(ErrorDir : String; User : String;

                        CallingClass : String; ErrorClass : String;

                        ErrorMsg : String);

var

 f : TextFile;

 FileName : String;

begin

 if (DirectoryExists(ErrorDir)) or

    (ErrorDir = '') then

  begin

   FileName := ErrorDir+User+FormatDateTime('mmddhhnnss', Now)+'.htm';

  end

 else

  begin

   FileName := User+FormatDateTime('mmddhhnnss', Now)+'.htm';

   MessageDlg('Your system appears to have a network connection problem.'+#10#13

    +'Please contact the Help Desk.', mtError, [mbOK], 0);

  end;

 AssignFile(f, FileName);

 Rewrite(f);

 Writeln(f, '<HTML><TITLE>Error File</TITLE><BODY>');

 Writeln(f, User+'<BR>');

 Writeln(f, FormatDateTime('mm/dd/yyyy hh:mm', Now)+'<BR>');

 Writeln(f, CallingClass+'<BR>');

 Writeln(f, ErrorClass+'<BR>');

 Writeln(f, ErrorMsg);

 Writeln(f, '</BODY></HTML>');

 CloseFile(f);

end;

 

procedure GetLatLongRange(var LatLongRange : TLatLongRange);

begin

 LatLongRange.StartLat := ((-LatLongRange.Radius/69.1)+LatLongRange.OriginLat);

 LatLongRange.EndLat := ((LatLongRange.Radius/69.1)+LatLongRange.OriginLat);

 LatLongRange.StartLong := ((-LatLongRange.Radius/69.1)+LatLongRange.OriginLong);

 LatLongRange.EndLong := ((LatLongRange.Radius/69.1)+LatLongRange.OriginLong);

end;

 

end.