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;

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;

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;

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;

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;

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;

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;

function WhoAmI: string;

var

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

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;

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;

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;

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;

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;

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;

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;

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.}<