(***************************************************************) (* *) (* TURBO-ACCESS DEMONSTRATION PROGRAM *) (* Simple Database *) (* Version 1.0 *) (* *) (***************************************************************) Program ExampleDatabaseToolboxConcepts; (***************************************************************) (* The following constants are required for data structures *) (* internal to the Database Toolbox. Please see the example *) (* program, SETCONST.PAS (called SCONST.PAS here in DL1 of *) (* SIG), which helps you select optimal values for these *) (* constants. *) (***************************************************************) const MaxDataRecSize = 342; MaxKeyLen = 15; PageSize = 16; PageStackSize = 10; Order = 8; MaxHeight = 5; NoDuplicates = 0; (*********************************************************************) (* The following include directives load in the Toolbox source code *) (*********************************************************************) {$I ACCESS.BOX } (* Includes the basic data types and file handling *) {$I ADDKEY.BOX } (* Includes the AddKey routine *) {$I DELKEY.BOX } (* Includes the DelKey routine *) {$I GETKEY.BOX } (* Includes search routines Find, Search, Prev, *) (* Next and ClearKey. *) (**************************************************************) (* The program type definitions can go here. *) (**************************************************************) TYPE CustRec = record CustStatus : integer; CustCode : string[15]; EntryDate : string[8]; FirstName : string[15]; LastName : string[30]; Company : string[40]; Addr1 : string[40]; Addr2 : string[40]; Phone : string[15]; PhoneExt : string[5]; Remarks1 : string[40]; Remarks2 : string[40]; Remarks3 : string[40]; end; (* CustRec *) FilenameType = string[64]; (**************************************************************) (* Global variable are declared here. *) (**************************************************************) var CustFile : DataFile; CodeIndx : IndexFile; Customer : CustRec; { The following code tells you how large to make the MaxDataRecSize constant. If you change the size of you record re-run the code. Remove the comment bracket below and then run. Then replace the bracket. } { begin Writeln('The size of my custrec type is ',SizeOf(CustRec)); Writeln('The MaxKeyLen is ',sizeof(Customer.CustCode)-1); end. } (***********************************************************************) (* Utility procedures which can be called from all other procedures *) (***********************************************************************) procedure Stop; begin GotoXY(1,24); Writeln; Writeln; Writeln; Writeln('Customer database program aborted.'); Halt; end { Stop execution }; (***********************************************************************) (* Open a file if it exist or prompt user if file needs to be created *) (***********************************************************************) procedure OpenDataFile(var CustFile : DataFile; Fname: FilenameType; Size : integer ); var create : char; begin OpenFile(CustFile, fname, Size); if not OK then begin Writeln(' The data file: ',fname,' was not found.'); Write('Do you wish to create it? '); Read(KBD, Create); Writeln(Create); if UpCase(create) = 'Y' then MakeFile(CustFile,fname,Size) else stop; end; If not OK Then stop; end { OpenDataFile }; (***********************************************************************) (* Obtain customer information from the user to put in the data base *) (***********************************************************************) procedure InputInformation(var Customer : CustRec); begin Writeln; Writeln(' Enter Customer Information '); Writeln; with Customer do begin CustStatus := 0; Write('Customer code: '); Readln(CustCode); Write('Entry date : '); Readln(EntryDate); Write('First name : '); Readln(FirstName); Write('Last name : '); Readln(LastName); Write('Company : '); Readln(Company); Writeln('Address '); Write(' Number & Street : '); Readln(Addr1); Write(' City, State & Zip : '); Readln(Addr2); Write('Phone : '); Readln(Phone); Write('Extention : '); Readln(PhoneExt); Write('Remarks : '); Readln(Remarks1); Write('Remarks : '); Readln(Remarks2); Write('Remarks : '); Readln(Remarks3); end; Writeln; end { InputInformation }; (***********************************************************************) (* Rebuild index files based on existing data files. *) (***********************************************************************) procedure RebuildIndex(VAR CustFile: DataFile; VAR CodeIndex: IndexFile); var RecordNumber : integer; begin InitIndex; MakeIndex(CodeIndex,'CodeFile.ndx', SizeOf(Customer.CustCode)-1,NoDuplicates); for RecordNumber := 1 to FileLen(CustFile) - 1 do begin GetRec(CustFile,RecordNumber,Customer); If Customer.CustStatus = 0 then AddKey(CodeIndex,RecordNumber,Customer.CustCode); end end { Rebuild Index }; (***********************************************************************) (* Setup index files -- open if exists, create if the user wants to. *) (***********************************************************************) procedure OpenIndexFile(var CodeIndx : IndexFile; Fname : FilenameType; KeySize : integer; Dups : integer); var create: char; begin InitIndex; OpenIndex(CodeIndx, Fname,KeySize,Dups); if not OK then begin Writeln(' The index file: ',fname,' was not found.'); Write('Do you wish to create it? '); Read(KBD, Create); if UpCase(Create) = 'Y' then RebuildIndex(CustFile,CodeIndx) else Stop; end; If not OK then Stop; end { OpenIndexFile }; (***********************************************************************) (* Place the customer information on the screen to be viewed *) (***********************************************************************) procedure DisplayCustomer(Customer: CustRec); begin with Customer do begin Writeln; WriteLn(' Code: ',CustCode,' Date: ',EntryDate); Writeln(' Name: ',FirstName,' ',LastName); WriteLn('Company: ',Company); Writeln('Address: ',Addr1); Writeln(' ',Addr2); Writeln(' Phone:',Phone,' ext. ',PhoneExt); WriteLn('Remarks: ',Remarks1); Writeln(' ',Remarks2); WriteLn(' ',Remarks3); end; Writeln; end { Display Customer }; (***********************************************************************) (* Access the customer records sequentially -- no index files. *) (***********************************************************************) procedure ListCustomers(var CustFile: DataFile); var NumberOfRecords, RecordNumber : integer; Pause : char; begin NumberOfRecords := FileLen(CustFile); Writeln(' Customers '); Writeln; for RecordNumber := 1 to NumberOfRecords - 1 do begin GetRec(CustFile,RecordNumber,Customer); if Customer.CustStatus = 0 then DisplayCustomer(Customer); end; Writeln; Write(' Press any key to continue . . .'); Read(KBD,Pause); Writeln; end (* ListCustomers *); (************************************************************************) (* Find customer based on customer code *) (************************************************************************) procedure FindCustomer(var CustFile: DataFile; var CodeIndx: IndexFile ); var RecordNumber : integer; SearchCode : string[15]; Pause : char; begin Write('Enter the Customer code: '); ReadLn(SearchCode); FindKey(CodeIndx,RecordNumber,SearchCode); if OK then begin GetRec(CustFile,RecordNumber,Customer); DisplayCustomer(Customer); end else Writeln('A record was not found for the key ',SearchCode); Writeln('Press any key to continue . . .'); Read(KBD,Pause); end { FindCustomer }; (************************************************************************) (* Search customer based on customer code *) (************************************************************************) procedure SearchCustomer(var CustFile: DataFile; var CodeIndx: IndexFile ); var RecordNumber : integer; SearchCode : string[15]; Pause : char; begin Write('Enter the Partial Customer code: '); ReadLn(SearchCode); SearchKey(CodeIndx,RecordNumber,SearchCode); if OK then begin GetRec(CustFile,RecordNumber,Customer); DisplayCustomer(Customer); end else Writeln('A record was not found greater than the key ',SearchCode); Writeln('Press any key to continue . . .'); Read(KBD,Pause); end { Search Customer }; (************************************************************************) (* Next customer based on customer code *) (************************************************************************) procedure NextCustomer(var CustFile: DataFile; var CodeIndx: IndexFile ); var RecordNumber : integer; SearchCode : string[15]; Pause : char; begin NextKey(CodeIndx,RecordNumber,SearchCode); if OK then begin GetRec(CustFile,RecordNumber,Customer); Write('The next customer is : '); DisplayCustomer(Customer); end else Writeln('The end of the database has been reached.'); Writeln('Press any key to continue . . .'); Read(KBD,Pause); end { Next Customer }; (************************************************************************) (* Previous customer based on customer code *) (************************************************************************) procedure PreviousCustomer(var CustFile: DataFile; var CodeIndx: IndexFile); var RecordNumber : integer; SearchCode : string[15]; Pause : char; begin PrevKey(CodeIndx,RecordNumber,SearchCode); if OK then begin GetRec(CustFile,RecordNumber,Customer); Write('The previous customer is : '); DisplayCustomer(Customer); end else Writeln('The start of the database has been reached.'); Writeln('Press any key to continue . . .'); Read(KBD,Pause); end { Previous Customer }; (****************************************************************************) (* AddCustomers inserts records into the data file and keys into the index *) (****************************************************************************) procedure AddCustomer(var CustFile: DataFile; var CodeIndx: IndexFile); var RecordNumber : integer; Response : char; begin repeat InputInformation(Customer); FindKey(CodeIndx,RecordNumber,Customer.CustCode); If not OK then begin AddRec(CustFile,RecordNumber,Customer); AddKey(CodeIndx,RecordNumber,Customer.CustCode); Write('Add another record? '); end else Write('Duplicate code exists. Try another code? '); Read(KBD,Response); Writeln(UpCase(Response)); until UpCase(Response) <> 'Y'; end { Add a Customer }; (****************************************************************************) (* DeleteCustomer accepts the customer code and deletes data and key info. *) (****************************************************************************) procedure DeleteCustomer(var CustFile: DataFile; var CodeIndx: IndexFile); var RecordNumber : integer; Response : char; CustomerCode : string[15]; { Same as CustRec.CustCode field } begin repeat Write(' Enter code of customer to be deleted: '); Readln(CustomerCode); FindKey(CodeIndx,RecordNumber,Customer.CustCode); if OK then begin DeleteKey(CodeIndx,RecordNumber,Customer.CustCode); DeleteRec(CustFile,RecordNumber); Write('Delete another record? '); end else Write('Customer code was not fould. Try another code? '); Read(KBD,Response); until UpCase(Response) <> 'Y'; end { Delete a Customer }; (****************************************************************************) (* UpdateCustomer show a customer and then allow reentry of information *) (****************************************************************************) procedure UpdateCustomer(var CustFile: DataFile; var CodeIndx: IndexFile); var RecordNumber : integer; Response : char; CustomerCode : string[15]; { Same as CustRec.CustCode field } begin repeat Write('Enter code of customer to be updated: '); Readln(CustomerCode); FindKey(CodeIndx,RecordNumber,CustomerCode); if OK then begin GetRec(CustFile,RecordNumber,Customer); DisplayCustomer(Customer); InputInformation(Customer); PutRec(CustFile,RecordNumber,Customer); If CustomerCode <> Customer.CustCode Then begin DeleteKey(CodeIndx,RecordNumber,CustomerCode); AddKey(CodeIndx,RecordNumber,Customer.CustCode); end; Write('Update another record? '); end else Write('Customer code was not found. Try another code? '); Read(KBD,Response); Writeln(UpCase(Response)); until UpCase(Response) <> 'Y'; end { Update customer }; (*******************************************************************) (* Main menu *) (*******************************************************************) function Menu: char; var action: char; begin ClrScr; GotoXY(1,3); Writeln(' Enter Number or First Letter'); Writeln; Writeln(' 1) List Customer Records '); Writeln(' 2) Find a Record by Customer Code '); Writeln(' 3) Search on Partial Customer Code '); Writeln(' 4) Next Customer'); Writeln(' 5) Previous Customer'); Writeln(' 6) Add to Customer Database '); Writeln(' 7) Edit a Customer Record '); Writeln(' 8) Delete a Customer Record '); Writeln(' 9) Rebuild Index files '); Writeln(' 0) Exit '); Writeln(' '); Read(KBD,Action); Writeln; Menu := UpCase(action); end { menu }; (***********************************************************************) (* Main program *) (***********************************************************************) var Finished: Boolean; begin Finished := false; OpenDataFile(CustFile,'CustFile.dat',SizeOf(CustRec)); OpenIndexFile(CodeIndx,'CodeFile.Ndx', SizeOf(Customer.CustCode)-1,NoDuplicates); repeat case Menu of '1','L': ListCustomers(CustFile); '2','F': FindCustomer(CustFile,CodeIndx); '3','S': SearchCustomer(CustFile,CodeIndx); '4','N': NextCustomer(CustFile,CodeIndx); '5','P': PreviousCustomer(CustFile,CodeIndx); '6','A': AddCustomer(CustFile,CodeIndx); '7','U': UpdateCustomer(CustFile,CodeIndx); '8','D': DeleteCustomer(CustFile,CodeIndx); '9','R': RebuildIndex(CustFile,CodeIndx); '0','E': Finished := true; else Write('Choose 0-9: '); end; { case } until Finished; CloseIndex(CodeIndx); CloseFile(CustFile); end.