CydandClaude Fable 5
63312e07f9
- BORLAND/: Borland C++ 4.52 (chosen over 4.5 by byte-match: CODE/RP/CW32.LIB
is identical to 4.52's install lib). BCC32/TLINK32/TLIB/MAKE run natively on
Win11; CODE/BT/OPT.MAK is the shipped BTL4OPT.EXE's exact flag recipe
(extender = Borland PowerPack DPMI32, not Phar Lap TNT).
- restoration/source410/: the literal 1995-form reconstruction of the missing
BT game source (never mixed into CODE/). Round 1-3 state:
* 6 of 10 surviving original TUs COMPILE CLEAN under the period toolchain
(BTMSSN, BTCNSL, BTSCNRL, BTTEAM, BTL4MODE, BTL4ARND) - first builds
since 1996.
* BT_L4/BTL4APP.CPP pilot reconstruction: 12/12 functions, Fail() lands on
its binary-recorded line 400 exactly.
* BT/BTCNSL.HPP: console wire IDs recovered from the binary's ctors
(Killed=9, Damaged=10, ScoreUpdate=13, DeathWithoutHonor=15 [T1];
TeamScore=12 flagged [T4]).
* MUNGA/: 8 engine-header backfills back-dated from the BT412 WinTesla tree
(VDATA numbering decomp-verified; AUDREND's OpenAL-era virtual removed -
the period compiler is the drift detector).
* Tooling: backdate.py (WinTesla->1995 header transform), compile410.sh
(per-TU verification sweep under authentic OPT.MAK flags).
* README: corrected roadmap - MECH.HPP is the capstone grown with the mech
TU reconstructions; BTREG.CPP green = the header-family milestone.
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
1283 lines
48 KiB
ObjectPascal
1283 lines
48 KiB
ObjectPascal
{$A+,B-,D+,F+,G+,I-,K+,L+,N+,P-,Q-,R-,S-,T-,V+,W+,X+,Y+}
|
|
{$M 25000,8192}
|
|
{************************************************}
|
|
{ }
|
|
{ Demo program }
|
|
{ Copyright (c) 1994 by Borland International }
|
|
{ }
|
|
{************************************************}
|
|
unit Engine;
|
|
|
|
interface
|
|
uses WinTypes, WinProcs, strings, IDAPI, DbiTypes, DbiErrs, BWCC, WinDos;
|
|
const
|
|
AppName = 'EMPLOYEE';
|
|
{ Field Lengths }
|
|
MaxFieldSize = 60; { Must be larger then any other field size below except
|
|
/ blob fields. }
|
|
Namelen = 32;
|
|
Addresslen = 50;
|
|
Citylen = 40;
|
|
StateLen = 3;
|
|
Ziplen = 12;
|
|
Phonelen = 20;
|
|
EmpIdLen = 10;
|
|
Datelen = 10;
|
|
Deptlen = 20;
|
|
CommentLen = 300;
|
|
|
|
{ FieldNums }
|
|
FNameNum = 1;
|
|
LNameNum = 2;
|
|
Address1Num = 3;
|
|
Address2Num = 4;
|
|
CityNum = 5;
|
|
StateNum = 6;
|
|
ZipNum = 7;
|
|
HPhoneNum = 8;
|
|
WPhoneNum = 9;
|
|
EmpIdNum = 10;
|
|
StartDateNum = 11;
|
|
EndDateNum = 12;
|
|
DepartmentNum = 13;
|
|
CommentsNum = 14;
|
|
|
|
NameIndex = 1;
|
|
EmpIDIndex = 2;
|
|
DeptIndex = 3;
|
|
|
|
{ Name of table to be created }
|
|
TblName = 'EMPLOYEE';
|
|
{ Type of Table }
|
|
TblType = szDBase;
|
|
{ Number of fields to be created when the table is created. }
|
|
NumFields = 14;
|
|
{ Number of indexes to be created when the table is created }
|
|
NumIndexes = 3;
|
|
|
|
type
|
|
PXIDXDesc = ^TIDXDesc;
|
|
TIDXDesc = array[1..NumIndexes] of IDXDesc;
|
|
PTempFldDesc = ^TempFldDesc;
|
|
TempFldDesc = array[1..NumFields] of FldDesc;
|
|
const
|
|
|
|
|
|
XFLDDesc: array[1..NumFields] of FldDesc = (
|
|
{ // Field 1 - First Name }
|
|
( iFldNum: FNameNum; { Field Number }
|
|
szName: 'FIRSTNAME'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: NameLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 2 - Last Name }
|
|
( iFldNum: LNameNum; { Field Number }
|
|
szName: 'LASTNAME'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: NameLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 3 - Address 1 }
|
|
( iFldNum: Address1Num; { Field Number }
|
|
szName: 'ADDRESS1'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: AddressLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 4 - Address 2 }
|
|
( iFldNum: Address2Num; { Field Number }
|
|
szName: 'ADDRESS2'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: AddressLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 5 - City }
|
|
( iFldNum: CityNum; { Field Number }
|
|
szName: 'CITY'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: CityLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 6 - State }
|
|
( iFldNum: StateNum; { Field Number }
|
|
szName: 'STATE'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: StateLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 7 - Zip }
|
|
( iFldNum: ZipNum; { Field Number }
|
|
szName: 'ZIP'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: ZipLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 8 - HPhone }
|
|
( iFldNum: HPhoneNum; { Field Number }
|
|
szName: 'HPHONE'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: PhoneLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 9 - WPhone }
|
|
( iFldNum: WPhoneNum; { Field Number }
|
|
szName: 'WPHONE'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: PhoneLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 10 - EmployeeID }
|
|
( iFldNum: EmpIDNum; { Field Number }
|
|
szName: 'EMPLOYEEID'; { Field Name }
|
|
iFldType: fldfLOAT; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: EmpIdLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 11 - StartDate }
|
|
( iFldNum: StartDateNum; { Field Number }
|
|
szName: 'STARTDATE'; { Field Name }
|
|
iFldType: fldDATE; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: 0; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 12 - EndDate }
|
|
( iFldNum: EndDateNum; { Field Number }
|
|
szName: 'ENDDATE'; { Field Name }
|
|
iFldType: fldDATE; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: 0; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
),
|
|
{ Field 13 - Department }
|
|
( iFldNum: DepartmentNum; { Field Number }
|
|
szName: 'DEPARTMENT'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: DeptLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
) ,
|
|
{ Field 14 - Comments }
|
|
( iFldNum: CommentsNum; { Field Number }
|
|
szName: 'COMMENTS'; { Field Name }
|
|
iFldType: fldBLOB; { Field Type }
|
|
iSubType: fldstMEMO; { Field Subtype }
|
|
iUnits1: CommentLen; { Field Size 1 or 0, except BLOb or CHAR field }
|
|
iUnits2: 0; { Decimal places ( 0 ) computed }
|
|
iOffset: 0; { Offset in record ( 0 ) }
|
|
iLen: 0; { Length in Bytes ( 0 ) }
|
|
iNullOffset: 0; { For Null Bits ( 0 ) }
|
|
efldvVchk: fldvNOCHECKS; { Validiy checks ( 0 ) }
|
|
efldrRights: fldrREADWRITE { Rights }
|
|
));
|
|
|
|
{ Index Descriptor - describes the Indexes associated with the
|
|
table. This index is going to be added to the table when the
|
|
table is created. }
|
|
|
|
XIDXDesc: array[1..NumIndexes] of IDXDesc = (
|
|
( { Index #1 - LASTNAME }
|
|
szName: ''; { Index name }
|
|
iIndexId: 1; { Index number }
|
|
szTagName: 'NAME'#0; { Tag name (for dBASE) }
|
|
szFormat: #0; { Optional format(BTREE, HASH etc) }
|
|
bPrimary: false; { True, if primary index }
|
|
bUnique: false; { True, if unique keys }
|
|
bDescending: false; { True, for descending }
|
|
bMaintained: true; { True, if maintained }
|
|
bSubset: false; { If subset index }
|
|
bExpIdx: true; { If expression index }
|
|
iCost: 0; { (For QBE only) }
|
|
iFldsInKey: 2; { Fields in the key }
|
|
iKeyLen: 1; { Phy Key length in bytes (Key only) }
|
|
bOutofDate: false; { Index out of date }
|
|
iKeyExpType: 0; { Key type of Expression }
|
|
aiKeyFld: (2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
{ Array of field numbers in key }
|
|
szKeyExp: 'TRIM(LASTNAME) + ", " + TRIM(FIRSTNAME)'#0; { Key expression }
|
|
szKeyCond: #0; { Subset condition }
|
|
bCaseInsensitive: false; { Case insensitive index }
|
|
iBlockSize: 0; { Block size in bytes }
|
|
iRestrNum: 0 { Restructure number }
|
|
),
|
|
( { Index #2 - Single-Field }
|
|
szName: ''; { Index name }
|
|
iIndexId: 2; { Index number }
|
|
szTagName: 'EMPLOYEEID'#0; { Tag name (for dBASE) }
|
|
szFormat: #0; { Optional format(BTREE, HASH etc) }
|
|
bPrimary: false; { True, if primary index }
|
|
bUnique: false; { True, if unique keys }
|
|
bDescending: false; { True, for descending }
|
|
bMaintained: true; { True, if maintained }
|
|
bSubset: false; { If subset index }
|
|
bExpIdx: false; { If expression index }
|
|
iCost: 0; { (For QBE only) }
|
|
iFldsInKey: 1; { Fields in the key (1 for Exp) }
|
|
iKeyLen: 1; { Phy Key length in bytes (Key only) }
|
|
bOutofDate: false; { Index out of date }
|
|
iKeyExpType: 0; { Key type of Expression }
|
|
aiKeyFld: (10,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0);{ Array of field numbers in key }
|
|
szKeyExp: #0; { Key expression }
|
|
szKeyCond: #0; { Subset condition }
|
|
bCaseInsensitive: false; { Case insensitive index }
|
|
iBlockSize: 0; { Block size in bytes }
|
|
iRestrNum: 0 { Restructure number }
|
|
),
|
|
( { Index #3 - Single-Field }
|
|
szName: ''; { Index name }
|
|
iIndexId: 3; { Index number }
|
|
szTagName: 'DEPARTMENT'#0; { Tag name (for dBASE) }
|
|
szFormat: #0; { Optional format(BTREE, HASH etc) }
|
|
bPrimary: false; { True, if primary index }
|
|
bUnique: false; { True, if unique keys }
|
|
bDescending: false; { True, for descending }
|
|
bMaintained: true; { True, if maintained }
|
|
bSubset: false; { If subset index }
|
|
bExpIdx: false; { If expression index }
|
|
iCost: 0; { (For QBE only) }
|
|
iFldsInKey: 1; { Fields in the key (1 for Exp) }
|
|
iKeyLen: 1; { Phy Key length in bytes (Key only) }
|
|
bOutofDate: false; { Index out of date }
|
|
iKeyExpType: 0; { Key type of Expression }
|
|
aiKeyFld: (13,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0);{ Array of field numbers in key }
|
|
szKeyExp: #0; { Key expression }
|
|
szKeyCond: #0; { Subset condition }
|
|
bCaseInsensitive: false; { Case insensitive index }
|
|
iBlockSize: 0; { Block size in bytes }
|
|
iRestrNum: 0 { Restructure number }
|
|
));
|
|
|
|
IDXDescriptions: array[1..NumIndexes] of PChar = (
|
|
'Indexed on Employee''s last name',
|
|
'Indexed on Employee''s identification number',
|
|
'Indexed on Employee''s department number');
|
|
|
|
type
|
|
|
|
PRecordType = ^TRecordType;
|
|
TRecordType = record
|
|
FName: array[0..NameLen] of char;
|
|
LName: array[0..NameLen] of char;
|
|
Address1: array[0..AddressLen] of char;
|
|
Address2: array[0..AddressLen] of char;
|
|
City: array[0..CityLen] of char;
|
|
State: array[0..StateLen] of char;
|
|
Zip: array[0..ZipLen] of char;
|
|
HPhone: array[0..PhoneLen] of char;
|
|
WPhone: array[0..PhoneLen] of char;
|
|
EmpId: double;
|
|
StartDate: array[0..DateLen] of char;
|
|
EndDate: array[0..DateLen] of char;
|
|
Department: array[0..DeptLen] of char;
|
|
Comments: array[0..CommentLen] of char;
|
|
end;
|
|
|
|
DateRec = record
|
|
Month, Day, Year: word
|
|
end;
|
|
|
|
PMoveArray = ^TMoveArray;
|
|
TMoveArray = array[1..10000] of byte; { Used on procedure MoveFromOffset }
|
|
|
|
const
|
|
DefaultRecord1: TRecordType = (FName: 'Jack'; LName: 'Dolittle';
|
|
Address1: '2734 Seabright Av.';
|
|
Address2: '108 Santas Village Wy.';
|
|
City: 'Nowheresville';
|
|
State: 'CA';
|
|
Zip: '95837';
|
|
HPhone: '(408)555-1213';
|
|
WPhone: '(408)555-1214';
|
|
EmpId: 2293;
|
|
StartDate: '12-24-90';
|
|
EndDate: '01-20-91';
|
|
Department: 'Marketing';
|
|
Comments: 'Poor worker, fired promptly.');
|
|
|
|
DefaultRecord2: TRecordType = (FName: 'Frank'; LName: 'Zipple';
|
|
Address1: '11432 1st Av.';
|
|
Address2: '38322 Branch Av.';
|
|
City: 'Walla Walla';
|
|
State: 'AZ';
|
|
Zip: '93947';
|
|
HPhone: '(408)555-1220';
|
|
WPhone: '(408)555-1221';
|
|
EmpId: 2291;
|
|
StartDate: '04-01-88';
|
|
EndDate: '06-24-93';
|
|
Department: 'Sales';
|
|
Comments: 'Good worker. Excellent experience.');
|
|
|
|
DefaultRecord3: TRecordType = (FName: 'Stan'; LName: 'Franich';
|
|
Address1: '1102 Bell St.';
|
|
Address2: '993 Worthington Wy.';
|
|
City: 'Soquel';
|
|
State: 'CA';
|
|
Zip: '38487';
|
|
HPhone: '(408)555-1230';
|
|
WPhone: '(408)555-1231';
|
|
EmpId: 2093;
|
|
StartDate: '04-01-80';
|
|
EndDate: '04-25-94';
|
|
Department: 'Research';
|
|
Comments: 'Excellent worker, quit for unknown reasons.');
|
|
|
|
DefaultRecord4: TRecordType = (FName: 'Brandy'; LName: 'Giberson';
|
|
Address1: '1234 845th St.';
|
|
Address2: '94832 Pacific Wy.';
|
|
City: 'Portland';
|
|
State: 'ME';
|
|
Zip: '28356';
|
|
HPhone: '(408)555-1240';
|
|
WPhone: '(408)555-1241';
|
|
EmpId: 374;
|
|
StartDate: '10-20-84';
|
|
EndDate: '04-09-92';
|
|
Department: 'QA';
|
|
Comments: 'Great worker.');
|
|
|
|
var
|
|
GlobalDBIErr: DBIResult;
|
|
|
|
{ Functions }
|
|
|
|
procedure SetPrivateDir;
|
|
procedure AddInitialRecords(hCur: HDBICur);
|
|
|
|
function FindTablesDir(var Dir: PChar; DirsBack: Byte): Boolean;
|
|
function DbInit: DBIResult;
|
|
function DbiError(RetVal: DBIResult): DBIResult;
|
|
function GetTable(var hDb: hDBIdb; var hCur: hDBICur) : DBIResult;
|
|
function CloseDb(hdb: hdbIDb; hCur: hDBICur): DBIResult;
|
|
function CreateTable: DBIResult;
|
|
function DeleteRec(hCur: hDBICur): DBIResult;
|
|
function AddRecord(hCur: hDBICur; PRec: PRecordType; Add: BOOL): DBIResult;
|
|
function GoTop(hCur: hDBICur; MoveRec: BOOL): DBIResult;
|
|
function GoBottom(hCur: hDBICur; MoveRec: BOOL): DBIResult;
|
|
function SetIndex(hCur: hDBICur; uNum: word; FirstRec: BOOL): DBIResult;
|
|
function GetData(hCur: hDBICur; pRecord: PRecordType): DBIResult;
|
|
function GetNextRec(hCur: hDBICur): DBIResult;
|
|
function GetPrevRec(hCur: hDBICur): DBIResult;
|
|
function AtEOF( hCur: hDBICur): BOOL;
|
|
function AtBOF( hCur: hDBICur): BOOL;
|
|
function GetIndexNum (hCur: hDBICur): word;
|
|
function Search(hCur: HDBICur; uCond: DBISearchCond; cKey: pBYTE): DBIResult;
|
|
function GetRecordCount(hCur: HDBICur): longint;
|
|
|
|
|
|
implementation
|
|
|
|
procedure SetPrivateDir;
|
|
var
|
|
PrivDir: String;
|
|
PPrivDir: PChar;
|
|
PTmp: PChar;
|
|
Rec: TSearchRec;
|
|
Error: array[0..200] of char;
|
|
IniFile: Boolean;
|
|
|
|
begin
|
|
GetMem(PPrivDir, 255);
|
|
{Get private directory from .ini file if it exists.}
|
|
GetPrivateProfileString(AppName, 'PrivateDir', '.', PPrivDir, 255, 'BDE.INI');
|
|
{If it does not exist...}
|
|
if PPrivDir[0] = '.' then
|
|
begin
|
|
IniFile := False;
|
|
{Derive directory from executable directory.}
|
|
PrivDir := ParamStr(0);
|
|
StrPCopy(PPrivDir, PrivDir);
|
|
PTmp := StrRScan(PPRivDir, '\');
|
|
PTmp^ := #0;
|
|
DBISetPrivateDir(PPrivDir);
|
|
end
|
|
else
|
|
IniFile := True;
|
|
{Make sure the directory exists.}
|
|
FindFirst(PPrivDir, faDirectory, Rec);
|
|
if DosError <> 0 then
|
|
begin
|
|
StrCopy(Error, 'Error setting private directory to ');
|
|
StrCat(Error, PPrivDir);
|
|
StrCat(Error, '. Using current directory.');
|
|
if IniFile = True then
|
|
StrCat (Error, ' Check BDE.INI file for private directory setting.');
|
|
MessageBox(0, Error, 'Warning', mb_Ok or mb_IconInformation);
|
|
{By default, the private directory is set to current drectory if DBISetPrivateDir
|
|
is not used or an error has occured setting private directory.}
|
|
end;
|
|
FreeMem(PPrivDir, 255);
|
|
end;
|
|
|
|
|
|
function FindTablesDir(var Dir: PChar; DirsBack: Byte): Boolean;
|
|
var
|
|
TblDir: String[dbiMAXPATHLEN + 1];
|
|
PTblDir: PChar;
|
|
B: Byte;
|
|
Rec: TSearchRec;
|
|
Error: array[0..200] of char;
|
|
IniFile: Boolean;
|
|
|
|
begin
|
|
{Get private directory from .ini file if it exists.}
|
|
GetPrivateProfileString(AppName, 'TblDir', '.', Dir, 255, 'BDE.INI');
|
|
{If it does not exist...}
|
|
if Dir[0] = '.' then
|
|
begin
|
|
IniFile := False;
|
|
{Derive table directory from executable directory.}
|
|
TblDir := ParamStr(0);
|
|
StrPCopy(Dir, TblDir);
|
|
for B := 1 to DirsBack do
|
|
begin
|
|
PTblDir := Dir;
|
|
PTblDir := StrRScan(PTblDir, '\');
|
|
if PTblDir = nil then
|
|
begin
|
|
BWCCMessageBox(0, 'An error occured finding tables directory!',
|
|
'ERROR', mb_OK or mb_IconExclamation);
|
|
{Use relative path since a absolute path could not be found.}
|
|
StrCopy(Dir, '..\..\TABLES');
|
|
FindTablesDir := False;
|
|
Break;
|
|
end
|
|
else
|
|
PTblDir^ := #0;
|
|
end;
|
|
if Dir[0] <> '.' then
|
|
begin
|
|
{Directory extraction worked.}
|
|
StrCat(Dir, '\TABLES');
|
|
FindTablesDir := True;
|
|
end;
|
|
end
|
|
else
|
|
IniFile := True;
|
|
{Make sure the directory exists.}
|
|
FindFirst(Dir, faDirectory, Rec);
|
|
if DosError <> 0 then
|
|
begin
|
|
StrCopy(Error, 'Error setting tables directory to ');
|
|
StrCat(Error, Dir);
|
|
StrCat(Error, '. Using relative path ..\..\TABLES.');
|
|
if IniFile = True then
|
|
StrCat (Error, ' Check BDE.INI file for table directory setting.');
|
|
|
|
MessageBox(0, Error, 'Warning', mb_Ok or mb_IconInformation);
|
|
StrCopy(Dir, '..\..\TABLES');
|
|
end;
|
|
end;
|
|
|
|
procedure AddInitialRecords(hCur: hDBICur);
|
|
begin
|
|
if AddRecord(hCur, @DefaultRecord1, true) <> DBIERR_NONE then
|
|
BWCCMessageBox(0, 'Error Adding Record', 'Error!', mb_ok);
|
|
if AddRecord(hCur, @DefaultRecord2, true) <> DBIERR_NONE then
|
|
BWCCMessageBox(0, 'Error Adding Record', 'Error!', mb_ok);
|
|
if AddRecord(hCur, @DefaultRecord3, true) <> DBIERR_NONE then
|
|
BWCCMessageBox(0, 'Error Adding Record', 'Error!', mb_ok);
|
|
if AddRecord(hCur, @DefaultRecord4, true) <> DBIERR_NONE then
|
|
BWCCMessageBox(0, 'Error Adding Record', 'Error!', mb_ok);
|
|
end;
|
|
|
|
procedure MoveFromOffset(var Source: TMoveArray; var Dest; FromOffset, Size: word);
|
|
var
|
|
L: LongInt;
|
|
|
|
begin
|
|
L := (FromOffset - 1) * Size + 1;
|
|
move(Source[L], Dest, Size);
|
|
end;
|
|
|
|
function GetHexWord(w: Word): String;
|
|
const
|
|
hexChars: array [0..$F] of Char =
|
|
'0123456789ABCDEF';
|
|
begin
|
|
GetHexWord := hexChars[Hi(w) shr 4] +
|
|
hexChars[Hi(w) and $F] +
|
|
hexChars[Lo(w) shr 4] +
|
|
hexChars[Lo(w) and $F];
|
|
end;
|
|
{=============================================================================
|
|
/ Name: DbiError
|
|
/ Description: This is function displays that is a message box about the
|
|
/ error that occured.
|
|
=============================================================================}
|
|
|
|
function DbiError(RetVal: DBIResult): DBIResult;
|
|
var
|
|
DbiErrString: array[0..128] of char;
|
|
ResStr: array[0..20] of char;
|
|
S: String;
|
|
begin
|
|
S := GetHexWord(RetVal);
|
|
StrPCopy(ResStr, S);
|
|
|
|
if (retVal = DBIERR_NONE) then
|
|
GlobalDBIErr := DBIERR_NONE
|
|
else
|
|
begin
|
|
GlobalDBIErr := RetVal;
|
|
DbiGetErrorString(retVal, DbiErrString); { Get the error message }
|
|
BWCCMessageBox(0, DbiErrString, ResStr, mb_ok);
|
|
end;
|
|
DbiError := retVal;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: SetDate
|
|
/ Desc: This function puts the date that is in the PChar into the
|
|
/ Date variable.
|
|
=============================================================================}
|
|
|
|
function SetDate(var Dt: Longint; DateString: PChar): DBIResult;
|
|
var
|
|
MonthInt: word;
|
|
DayInt: word;
|
|
YearInt: word;
|
|
MonthAry: array[0..2] of char;
|
|
DayAry: array[0..2] of char;
|
|
YearAry: array[0..4] of char;
|
|
Code: integer;
|
|
RetVal: DBIResult;
|
|
begin
|
|
{ Get the first two month's numbers (the first two numbers). }
|
|
strLCopy(MonthAry, DateString, 2);
|
|
strLCopy(DayAry, @DateString[3], 2);
|
|
strLCopy(YearAry, @DateString[6], 4);
|
|
val(MonthAry, MonthInt, Code);
|
|
val(DayAry, DayInt, Code);
|
|
val(YearAry, YearInt, Code);
|
|
|
|
RetVal := DbiDateEncode(MonthInt, DayInt, YearInt, Dt);
|
|
if RetVal <> DBIERR_NONE then
|
|
BWCCMessageBox(0, 'Invalid Date Format', 'Error', mb_OK);
|
|
SetDate := RetVal;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: DbInit
|
|
/ Desc: This function starts up the engine.
|
|
=============================================================================}
|
|
function DbInit: DBIResult;
|
|
var
|
|
PEnv: PDbiEnv;
|
|
rslt: DBIResult;
|
|
begin
|
|
PEnv := nil;
|
|
rslt := DbiError(DbiInit(PEnv));
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
Dbinit := rslt;
|
|
exit;
|
|
end;
|
|
|
|
DbiDebugLayerOptions(11, 'EMPLOYEE.INF');
|
|
|
|
DbInit := rslt;
|
|
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: GetTable
|
|
/ Desc: This function opens a database and a table.
|
|
=============================================================================}
|
|
function GetTable(var hDb: hDBIdb; var hCur: hDBICur) : DBIResult;
|
|
var
|
|
S: array[0..100] of Char;
|
|
TableDir: PChar;
|
|
begin
|
|
GetMem(TableDir, dbiMAXPATHLEN + 1);
|
|
FindTablesDir(TableDir, 3);
|
|
{ Open a standard database handle }
|
|
DbiError(DbiOpenDatabase(nil, nil, dbiREADWRITE, dbiOPENSHARED,
|
|
nil, 0, nil, nil, hdb));
|
|
if (GlobalDBIErr <> DBIERR_NONE) then
|
|
begin
|
|
GetTable := GlobalDBIErr;
|
|
Exit;
|
|
end;
|
|
{ Set the directory for the table handle }
|
|
DbiError(DbiSetDirectory(hdb, TableDir));
|
|
|
|
{ Now open the table to acquire a cursor on the table. }
|
|
DbiError(DbiOpenTable(hdb, TblName, TblType, nil, nil, 0,
|
|
dbiREADWRITE, dbiOPENSHARED,
|
|
xltFIELD, FALSE, nil, hCur));
|
|
if (GlobalDBIErr <> DBIERR_NONE) then
|
|
GetTable := GlobalDBIErr
|
|
else
|
|
GetTable := DBIERR_NONE;
|
|
FreeMem(TableDir, dbiMAXPATHLEN + 1);
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: CreateTable
|
|
/ Desc: This function opens a database and creates a table.
|
|
=============================================================================}
|
|
function CreateTable: DBIResult;
|
|
var
|
|
crTblDsc: CRTblDesc; { Table Descriptor }
|
|
bOverWrite: BOOL; { Overwrite, yes/no flag }
|
|
TableDir: PChar;
|
|
hdb: hdbIDb;
|
|
|
|
begin
|
|
GetMem(TableDir, dbiMAXPATHLEN + 1);
|
|
bOverWrite := TRUE;
|
|
{ Set the directory for the database handle }
|
|
DbiError(DbiOpenDatabase(nil, nil, dbiREADWRITE, dbiOPENSHARED,
|
|
nil, 0, nil, nil, hdb));
|
|
|
|
|
|
FindTablesDir(TableDir, 3);
|
|
|
|
DbiError(DbiSetDirectory(hdb, TableDir));
|
|
|
|
fillchar(crTblDsc, sizeof(CRTblDesc), #0); { Clear the buffer. }
|
|
|
|
{ Set the name and the type of the table }
|
|
strcopy(crTblDsc.szTblName, TblName); { name of the table }
|
|
strcopy(crTblDsc.szTblType, TblType); { Type of table }
|
|
|
|
{ Set the field information for the table }
|
|
|
|
crTblDsc.iFldCount := NumFields; { number of fields }
|
|
crTblDsc.pfldDesc := @XFldDesc; { Field descriptor }
|
|
|
|
{ Set the index information for the table }
|
|
|
|
crTblDsc.iIdxCount := NumIndexes; { Number of indexes }
|
|
crTblDsc.pidxDesc := @XIDXDesc; { Index descriptor }
|
|
|
|
{ Create the table using information supplied in the Table
|
|
{ Descrpitor above }
|
|
DbiError(DbiCreateTable(hdb, bOverWrite, crTblDsc));
|
|
|
|
if(GlobalDBIErr <> DBIERR_NONE) then
|
|
begin
|
|
CreateTable := GlobalDBIErr;
|
|
DbiError(DbiCloseDatabase(hDb));
|
|
FreeMem(TableDir, dbiMAXPATHLEN + 1);
|
|
exit;
|
|
end;
|
|
|
|
{CloseDatabase}
|
|
DbiError(DbiCloseDatabase(hDb));
|
|
|
|
|
|
if(GlobalDBIErr <> DBIERR_NONE) then
|
|
CreateTable := GlobalDBIErr
|
|
else
|
|
CreateTable := DBIERR_NONE;
|
|
FreeMem(TableDir, dbiMAXPATHLEN + 1);
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: DeleteRec
|
|
/ Desc: This function deletes the record that is pointed to by the
|
|
/ cursor.
|
|
=============================================================================}
|
|
|
|
function DeleteRec (hCur: hDBICur): DBIResult;
|
|
begin
|
|
DbiError(DbiGetRecord(hCur, dbiWRITELOCK, nil, nil));
|
|
DbiError(DbiDeleteRecord(hCur, nil));
|
|
DeleteRec := GlobalDBIErr;
|
|
end; { DeleteRec }
|
|
|
|
{=============================================================================
|
|
/ Name: AddRecord
|
|
/ Desc: This function adds a record to the table pointed at by the cursor.
|
|
=============================================================================}
|
|
function AddRecord(hCur: hDBICur; PRec: PRecordType; Add: BOOL): DBIResult;
|
|
var
|
|
PRecBuf: pByte; { Record buffer }
|
|
TblProps: CURProps; { Table Properties }
|
|
j: integer; { Field loop counter }
|
|
Date1, Date2: Longint;
|
|
RetVal: DBIResult;
|
|
|
|
begin
|
|
j := 1;
|
|
pRecBuf := nil;
|
|
DbiError(DbiGetCursorProps(hCur, TblProps));
|
|
|
|
getmem(PRecBuf, sizeof(TRecordType));
|
|
{ Make sure we're starting with a clean record buffer }
|
|
DbiError(DbiInitRecord(hCur, pRecBuf));
|
|
|
|
{ Fill each field with the structure's data }
|
|
DbiError(DbiPutField(hCur, FNameNum, pRecBuf, @PRec^.FName));
|
|
DbiError(DbiPutField(hCur, LNameNum, pRecBuf, @PRec^.LName));
|
|
DbiError(DbiPutField(hCur, Address1Num, pRecBuf, @PRec^.Address1));
|
|
DbiError(DbiPutField(hCur, Address2Num, pRecBuf, @PRec^.Address2));
|
|
DbiError(DbiPutField(hCur, CityNum, pRecBuf, @PRec^.City));
|
|
DbiError(DbiPutField(hCur, StateNum, pRecBuf, @PRec^.State));
|
|
DbiError(DbiPutField(hCur, ZipNum, pRecBuf, @PRec^.Zip));
|
|
DbiError(DbiPutField(hCur, HPhoneNum, pRecBuf, @PRec^.HPhone));
|
|
DbiError(DbiPutField(hCur, WPhoneNum, pRecBuf, @PRec^.WPhone));
|
|
DbiError(DbiPutField(hCur, EmpIDNum, pRecBuf, @PRec^.EmpID));
|
|
DbiError(DbiPutField(hCur, DepartmentNum, pRecBuf, @PRec^.Department));
|
|
|
|
RetVal := SetDate(Date1, PRec^.StartDate);
|
|
|
|
if RetVal = DBIERR_NONE then
|
|
begin
|
|
DbiError(DbiPutField(hCur, StartDateNum, pRecBuf, @Date1));
|
|
|
|
if (strcomp(PRec^.EndDate, '') <> 0) then
|
|
begin
|
|
SetDate(Date2, PRec^.EndDate);
|
|
DbiError(DbiPutField(hCur, EndDateNum, pRecBuf, @Date2));
|
|
end
|
|
else DbiError(DbiPutField(hCur, EndDateNum, pRecBuf, nil)); { XXX AddRec}
|
|
|
|
DbiError(DbiOpenBlob(hCur, pRecBuf, CommentsNum, dbiREADWRITE));
|
|
DbiError(DbiPutBlob(hCur, pRecBuf, CommentsNum, 0, strlen(PRec^.Comments)+1, @PRec^.Comments));
|
|
|
|
if(Add) then
|
|
begin
|
|
{ Insert the record }
|
|
DbiError(DbiInsertRecord(hCur, dbiWRITELOCK, pRecBuf));
|
|
{ Release the record lock }
|
|
DbiError(DbiRelRecordLock(hCur, false));
|
|
end
|
|
else
|
|
begin
|
|
{ Overwrite the record }
|
|
{ Get WriteLock rights to this record to modify it. }
|
|
DeleteRec(hCur);
|
|
DbiError(DbiInsertRecord(hCur, dbiWRITELOCK, pRecBuf));
|
|
DbiError(DbiRelRecordLock(hCur, FALSE));
|
|
end;
|
|
|
|
{ NOW YOU MUST FREE the blob. }
|
|
DbiError(DbiFreeBlob(hCur, pRecBuf, CommentsNum));
|
|
freemem(PRecBuf, sizeof(TRecordType));
|
|
RetVal := GlobalDBIErr;
|
|
end;
|
|
|
|
AddRecord := RetVal;
|
|
end; { AddRecord }
|
|
|
|
{=============================================================================
|
|
/ Name: FillRec
|
|
/ Desc: This function adds a record to the table pointed at by the cursor.
|
|
=============================================================================}
|
|
function FillRec (hCur: hDBICur; pRecBuf: pByte; PRec: PRecordType): DBIResult;
|
|
var
|
|
DateInt: longint;
|
|
DayInt: word; { Day part of the date }
|
|
MonthInt: word; { Month part of the date }
|
|
YearInt: integer; { Year part of the date }
|
|
Actual: longint; { Total amount read from blob }
|
|
BlobSize: longint; { Size of blob }
|
|
FieldEmpty: BOOL; { Is field empty variable }
|
|
TempStr: array[0..MaxFieldSize] of char; { Temporary variable for reading data }
|
|
Code: integer;
|
|
DtRec: DateRec;
|
|
Date1, Date2: longint;
|
|
begin
|
|
{ Put each field into the data structure }
|
|
DbiError(DbiGetField(hCur, FNameNum, pRecBuf, @PRec^.FName, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, LNameNum, pRecBuf, @Prec^.LName, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, Address1Num, pRecBuf, @Prec^.Address1, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, Address2Num, pRecBuf, @PRec^.Address2, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, CityNum, pRecBuf, @PRec^.City, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, StateNum, pRecBuf, @PRec^.State, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, ZipNum, pRecBuf, @PRec^.Zip, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, HPhoneNum, pRecBuf, @PRec^.HPhone, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, WPhoneNum, pRecBuf, @PRec^.WPhone, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, EmpIDNum, pRecBuf, @PRec^.EmpID, FieldEmpty));
|
|
DbiError(DbiGetField(hCur, DepartmentNum, pRecBuf, @PRec^.Department, FieldEmpty));
|
|
|
|
DbiError(DbiGetField(hCur, StartDateNum, pRecBuf, @Date1, FieldEmpty));
|
|
DbiError(DbiDateDecode(Date1, MonthInt, Dayint, YearInt));
|
|
DtRec.Month := MonthInt;
|
|
DtRec.Day := DayInt;
|
|
DtRec.Year := YearInt;
|
|
{ Format the date to MM\DD\YYYY format }
|
|
wvsprintf(PRec^.StartDate, '%02u-%02u-%02u', DtRec);
|
|
{ XXX FillRec }
|
|
DbiError(DbiGetField(hCur, EndDateNum, pRecBuf, nil, FieldEmpty));
|
|
if FieldEmpty = false then
|
|
begin
|
|
DbiError(DbiGetField(hCur, EndDateNum, pRecBuf, @Date2, FieldEmpty));
|
|
DbiError(DbiDateDecode(Date2, MonthInt, Dayint, YearInt));
|
|
DtRec.Month := MonthInt;
|
|
DtRec.Day := DayInt;
|
|
DtRec.Year := YearInt;
|
|
{ Format the date to MM\DD\YYYY format }
|
|
wvsprintf(PRec^.EndDate, '%02u-%02u-%02u', DtRec)
|
|
end
|
|
else strcopy(PRec^.EndDate, '');
|
|
|
|
|
|
DbiError(DbiOpenBlob(hCur, pRecBuf, CommentsNum, dbiREADWRITE));
|
|
{ Now get the size of the blob so that you can allocate the
|
|
/ correct amount of memory. The BlobSize variable is a UINT32. }
|
|
DbiError(DbiGetBlobSize(hCur, pRecBuf, CommentsNum, BlobSize));
|
|
DbiError(DbiGetBlob(hCur, pRecBuf, CommentsNum, 0, BlobSize,
|
|
@PRec^.Comments, Actual));
|
|
PRec^.Comments[BlobSize] := #0;
|
|
DbiError(DbiFreeBlob(hCur, pRecBuf, CommentsNum));
|
|
FillRec := DBIERR_NONE;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: GetData
|
|
/ Desc: This function gets the data pointed to by hCur and puts it
|
|
/ into the record structure.
|
|
=============================================================================}
|
|
function GetData (hCur: hDBICur; pRecord: PRecordType): DBIResult;
|
|
var
|
|
TblProps: CURProps;
|
|
PRecBuf: pByte;
|
|
Rslt: DBIResult;
|
|
begin
|
|
PRecBuf := nil;
|
|
{ Get the proporties of the table so that we can create the correct
|
|
/ buffer size for the record. We will read the record into the buffer
|
|
/ and then we will pull the field from the buffer.
|
|
}
|
|
DbiError(DbiGetCursorProps(hCur, TblProps));
|
|
|
|
{ Create the record buffer. The size comes from the proporty recsize. }
|
|
|
|
getmem(PRecBuf, sizeof(TRecordType));
|
|
|
|
{ Initialize the record buffer. }
|
|
DbiError(DbiInitRecord(hCur, PRecBuf));
|
|
|
|
{ Get the current reocord with a READLOCK. }
|
|
Rslt := DbiGetRecord(hCur, dbiREADLOCK, pRecBuf, nil);
|
|
|
|
if(Rslt = DBIERR_NONE) then
|
|
begin
|
|
{ Fill the structure with the present record pointed to by hCur. }
|
|
DbiError(FillRec(hCur, pRecBuf, pRecord));
|
|
{ Now free the record lock on this record ONLY. }
|
|
DbiError(DbiRelRecordLock(hCur, false));
|
|
end;
|
|
freemem(pRecBuf, sizeof(TRecordType));
|
|
GetData := DBIERR_NONE;
|
|
end; { GetData }
|
|
|
|
{=============================================================================
|
|
/ Name: GetPrevRec
|
|
/ Desc: This function moves one record backwards.
|
|
=============================================================================}
|
|
function GetPrevRec(hCur: hDBICur): DBIResult;
|
|
begin
|
|
DbiError(DbiGetPriorRecord(hCur, dbiNOLOCK, nil, nil));
|
|
GetPrevRec := GlobalDBIErr;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: GoBottom
|
|
/ Desc: This function moves to the bottom of the table, and moves one
|
|
/ record back if MoveRec (BOOL) is TRUE.
|
|
=============================================================================}
|
|
function GoBottom (hCur: hDBICur; MoveRec: BOOL): DBIResult;
|
|
begin
|
|
DbiError(DbiSetToEnd(hCur));
|
|
if(MoveRec) then
|
|
GetPrevRec(hCur);
|
|
GoBottom := GlobalDBIErr;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: GetNextRec
|
|
/ Desc: This function moves one record forward.
|
|
=============================================================================}
|
|
function GetNextRec (hCur: hDBICur): DBIResult;
|
|
begin
|
|
DbiError(DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil));
|
|
GetNextRec := GlobalDBIErr;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: GoTop
|
|
/ Desc: This function moves to the top of the table, and moves one
|
|
/ record forward if MoveRec (BOOL) is TRUE.
|
|
=============================================================================}
|
|
function GoTop (hCur: hDBICur; MoveRec: BOOL): DBIResult;
|
|
begin
|
|
DbiError(DbiSetToBegin(hCur));
|
|
if(MoveRec) then
|
|
GetNextRec(hCur);
|
|
GoTop := GlobalDBIErr;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: AtEOF
|
|
/ Desc: This function moves one record forward to test if the cursor
|
|
/ is at the EOF, and then moves back to put the cursor at the
|
|
/ place it was before jumping to the function.
|
|
=============================================================================}
|
|
function AtEOF ( hCur: hDBICur): BOOL;
|
|
var
|
|
rslt: DBIResult;
|
|
RetVal: BOOL;
|
|
begin
|
|
{ Check if we are at the end of the table. }
|
|
|
|
rslt := DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil);
|
|
if(rslt = DBIERR_NONE) then
|
|
begin
|
|
RetVal := false
|
|
end
|
|
else
|
|
begin
|
|
RetVal := true;
|
|
end;
|
|
{ Now put the cursor back to where it was before entering this function. }
|
|
DbiGetPriorRecord(hCur, dbiNOLOCK, nil, nil);
|
|
AtEOF := RetVal;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: AtBOF
|
|
/ Desc: This function moves one record backwards to test if the cursor
|
|
/ is at the BOF. Then it moves the cursor one record forward to
|
|
/ put it back to where it was originally.
|
|
=============================================================================}
|
|
function AtBOF (hCur: hDBICur): BOOL;
|
|
var
|
|
rslt: DBIResult;
|
|
RetVal: BOOL;
|
|
begin
|
|
{ Check if we are at the end of the table. }
|
|
rslt := DbiGetPriorRecord(hCur, dbiNOLOCK, nil, nil);
|
|
if(rslt = DBIERR_NONE) then
|
|
RetVal := false
|
|
else
|
|
RetVal := true;
|
|
{ Now put the cursor back to where it was before entering this function. }
|
|
DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil);
|
|
AtBOf := RetVal;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: CloseDb
|
|
/ Desc: This function closes the table based upon the table pointer
|
|
/ that was passed into the function.
|
|
=============================================================================}
|
|
function CloseDb (hdb: hdbIDb; hCur: hDBICur): DBIResult;
|
|
begin
|
|
if DbiCloseCursor(hCur) <> dbierr_None then
|
|
BWCCMessageBox(0, 'Error closing cursor', 'ERROR', mb_Ok);
|
|
|
|
if DbiCloseDatabase(hdb) <> dbierr_None then
|
|
BWCCMessageBox(0, 'Error closing database', 'ERROR in wmClose', mb_Ok);
|
|
CloseDb := DbiExit;
|
|
end;
|
|
{=============================================================================
|
|
/ Name: SetupIndex
|
|
/ Desc: This function switches to an index based upon the index array that
|
|
/ is used to create the table, and the IndexNum that is passed into
|
|
/ the function. The IndexNum corresponds to an element in the array.
|
|
=============================================================================}
|
|
function SetupIndex (hCur: hdbICur; IndexNum: word; FirstRec: BOOL): DBIResult;
|
|
var
|
|
MyDesc: PIDXDesc; { Index Descriptor }
|
|
begin
|
|
MyDesc := nil;
|
|
GetMem(MyDesc, sizeof(IdxDesc));
|
|
|
|
{ Get any index descriptor, because ALL the tags have the same index name,
|
|
/ but they have different tag names.
|
|
}
|
|
|
|
DbiError(DbiGetIndexDesc(hCur, 1, MyDesc^));
|
|
|
|
{ Switch to the index based upon the IndexNum which reflects the element
|
|
/ number of the idxDesc array. the idxDesc array is the array of indexes
|
|
/ used to create the table.
|
|
}
|
|
|
|
DbiError(DbiSwitchToIndex(hCur, MyDesc^.szName, XIDXDesc[IndexNum].szTagName,
|
|
IndexNum, FirstRec));
|
|
|
|
freeMem(MyDesc, sizeof(IdxDesc));
|
|
SetupIndex := DBIERR_NONE;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: GetIndexNum
|
|
/ Desc: This function returns the index number that corresponds to
|
|
/ the index found in the index array (idxDesc).
|
|
=============================================================================}
|
|
|
|
function GetIndexNum (hCur: hDBICur): word;
|
|
var
|
|
i: word;
|
|
Num: integer; { set it to a value it can never reach. }
|
|
MyDesc: pIDXDesc; { Index Descriptor. }
|
|
begin
|
|
i := 1;
|
|
Num := 300;
|
|
|
|
GetMem(MyDesc, sizeof(IdxDesc));
|
|
|
|
if (MyDesc = nil) then
|
|
begin
|
|
DbiExit;
|
|
GetIndexNum := DBIERR_NOMEMORY;
|
|
end;
|
|
|
|
{ Get information about the indexes }
|
|
DbiError(DbiGetIndexDesc(hCur, 0, MyDesc^));
|
|
|
|
{ Loop until you found a match or until the maximum number of indexes
|
|
that are open on this table. }
|
|
while (i < NumIndexes) and (Num <> 0) do
|
|
begin
|
|
{ compare the current tagname with the names we know. If it matches
|
|
/ then return that element number of the index array. }
|
|
Num := strcomp(MyDesc^.szTagName, XIDXDesc[i].szTagName);
|
|
inc(i);
|
|
end;
|
|
FreeMem(MyDesc, sizeof(idxDesc));
|
|
{ return the current index number. }
|
|
GetIndexNum := i-1;
|
|
end; { GetIndexNum }
|
|
|
|
{=============================================================================
|
|
/ Name: Search()
|
|
/ Desc: This function searches for a string based upon the index that
|
|
/ is presently active on the table.
|
|
=============================================================================}
|
|
function Search (hCur: HDBICur; uCond: DBISearchCond; cKey: pBYTE): DBIResult;
|
|
var
|
|
Result: DBIResult;
|
|
STblProps: CURProps;
|
|
SIdxDesc: IDXDesc;
|
|
SFldDesc: FLDDesc;
|
|
FldDescAry: PMoveArray;
|
|
FldNum: Integer;
|
|
TempDoub: double;
|
|
TempInt: integer;
|
|
RecBuf: pBYTE;
|
|
code: integer;
|
|
RetVal: DBIResult;
|
|
begin
|
|
{ Get information about the current index }
|
|
DBIError(DbiGetIndexDesc(hCur, 0, SidxDesc));
|
|
|
|
if SidxDesc.bExpIdx = True then
|
|
begin
|
|
Result := DbiSetToKey(hCur, uCond, True, 0, 0, cKey);
|
|
{ Display an error message if an error other than Record not Found
|
|
/ is detected.}
|
|
if ((Result <> DBIERR_NONE) and ( Result <> DBIERR_RECNOTFOUND)) then
|
|
DBIError(Result);
|
|
|
|
Search := Result;
|
|
exit;
|
|
end;
|
|
|
|
{ Determine the first field of the Index }
|
|
FldNum := SidxDesc.aiKeyFld[0];
|
|
|
|
{ Get information about the cursor - needed to determine the number
|
|
/ of fields in the table. }
|
|
DBIError(DbiGetCursorProps(hCur, STblProps));
|
|
|
|
{ Allocate a Field descriptior large enough to contain information about
|
|
/ all fields in the table. }
|
|
getmem(FldDescAry, sizeof(FldDesc)*STblProps.iFields);
|
|
|
|
{ Get the field descriptors - needed to determine the type of the
|
|
/ first field of the index.}
|
|
DBIError(DbiGetFieldDescs(hCur, PFldDesc(FldDescAry)));
|
|
{ procedure MoveFromOffset(var Source: TMoveArray; var Dest; FromOffset, Size: word);}
|
|
MoveFromOffset(FldDescAry^, SFldDesc, FldNum, sizeof(FldDesc));
|
|
|
|
getmem(RecBuf, sizeof(STblProps.iRecBufSize));
|
|
|
|
{ Initialize the record buffer }
|
|
DBIError(DbiInitRecord(hCur, RecBuf));
|
|
{ Write the data to the record buffer. }
|
|
case SFldDesc.iFldType of
|
|
fldINT16:
|
|
begin
|
|
val(PChar(cKey), TempInt, code);
|
|
DBIError(DbiPutField(hCur, FldNum, RecBuf, @TempInt));
|
|
end;
|
|
fldFLOAT:
|
|
begin
|
|
val(PChar(cKey), TempDoub, code);
|
|
DBIError(DbiPutField(hCur, FldNum, RecBuf, @TempDoub));
|
|
end;
|
|
fldZSTRING:
|
|
begin
|
|
DBIError(DbiPutField(hCur, FldNum, RecBuf, cKey));
|
|
end;
|
|
else
|
|
begin
|
|
BWCCMessageBox(0, 'Cannot Search Expression Indexes', 'Message',
|
|
MB_ICONHAND or MB_OK);
|
|
freemem(FldDescAry, sizeof(FldDesc)*STblProps.iFields);
|
|
freemem(RecBuf, sizeof(STblProps.iRecBufSize));
|
|
RetVal := DBIERR_NOTSUPPORTED;
|
|
exit;
|
|
end;
|
|
end; { case }
|
|
|
|
{ Perform the actual search on the table. }
|
|
Result := DbiSetToKey(hCur, uCond, FALSE, 0, 0, RecBuf);
|
|
|
|
{ Display an error message if an error other than Record not Found
|
|
/ is detected.}
|
|
if ((Result <> DBIERR_NONE) and ( Result <> DBIERR_RECNOTFOUND)) then
|
|
DBIError(Result);
|
|
|
|
freemem(FldDescAry, sizeof(FldDesc)*STblProps.iFields);
|
|
freemem(RecBuf, sizeof(STblProps.iRecBufSize));
|
|
Search := Result;
|
|
end;
|
|
|
|
{=============================================================================
|
|
/ Name: SetIndex
|
|
/ Desc: This function runs SetupIndex and moves the new cursor to the
|
|
/ first record in the table.
|
|
=============================================================================}
|
|
function SetIndex (hCur: hDBICur; uNum: word; FirstRec: BOOL): DBIResult;
|
|
begin
|
|
{ Move to the top of the table do not move forward one record past the crack. }
|
|
GoTop(hCur, FirstRec);
|
|
SetupIndex(hCur, uNum, FirstRec);
|
|
GoTop(hCur, FirstRec);
|
|
SetIndex := DBIERR_NONE;
|
|
end;
|
|
|
|
function GetRecordCount(hCur: HDBICur): longint;
|
|
var
|
|
TblProps: CURProps; { Table Properties }
|
|
PBookMark: Pointer;
|
|
RecCount: longint;
|
|
rslt: DBIResult;
|
|
begin
|
|
{ Return 0 if the table is empty }
|
|
rslt := DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil);
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
rslt := DbiGetPriorRecord(hCur, dbiNOLOCK, nil, nil);
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
GetRecordCount := 0;
|
|
exit;
|
|
end;
|
|
{ Reset the current location if no error }
|
|
DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil);
|
|
end
|
|
else begin
|
|
{ Reset the current location if no error }
|
|
DbiGetPriorRecord(hCur, dbiNOLOCK, nil, nil);
|
|
end;
|
|
|
|
{ Count the number of records }
|
|
|
|
RecCount := 0;
|
|
DbiError(DbiGetCursorProps(hCur, TblProps));
|
|
GetMem(PBookMark, TblProps.iBookMarkSize);
|
|
DbiError(DbiGetBookMark(hCur, PBookMark));
|
|
DbiSetToBegin(hCur);
|
|
while DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil) = DBIERR_NONE do
|
|
begin
|
|
inc(RecCount);
|
|
end;
|
|
DbiError(DbiSetToBookMark(hCur, PBookMark));
|
|
FreeMem(PBookMark, TblProps.iBookMarkSize);
|
|
GetRecordCount := RecCount;
|
|
end;
|
|
|
|
begin
|
|
end.
|
|
|
|
|
|
|
|
|