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.