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