{$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.