home *** CD-ROM | disk | FTP | other *** search
- {$X+}
- {$V-}
- { EXAMPLE1.PAS - demonstrate file creation with multiple keys,
- string justification, error trapping,
- reading by key value, reading by file position
- updating records
-
- Requires Turbo Pascal version 6.0
- }
-
- Uses
- Crt,
- Dos,
- Btv;
-
-
- type
- ErrorType = Object(ErrorDisplay)
- Function Display(Error : Integer;
- ErrorMsg : String;
- OpCode : Byte;
- OpCodeMsg : String;
- FileName : PathStr
- ): ErrorAction; Virtual;
- end;
-
-
- var
- F : BtrieveFile;
- Buff : record
- Name : String[30];
- Number : String[5];
- Comment : String[80];
- end;
- Pos : LongInt;
- Name : String[30];
- Number : String[5];
- ErrHandler : ErrorHandler;
- ErrDisplay : ErrorType;
- Major : Word;
- Minor : Word;
- Flag : Char;
-
-
- { Heres our error display object }
- Function ErrorType.Display(Error : Integer;
- ErrorMsg : String;
- OpCode : Byte;
- OpCodeMsg : String;
- FileName : PathStr
- ): ErrorAction;
- begin
- ClrScr;
- Writeln('Btrieve IO error for ' + FileName);
- Writeln(Error, ' - ', ErrorMsg);
- Writeln(Opcode, ' - ', OpCodeMsg);
- Writeln('Press any key ....');
- ReadKey;
- Display := erDone; { just let the program continue }
- ClrScr;
- end;
-
- begin
- { first make a error display }
- ErrDisplay.Init;
- { make an error handler, it needs a display object }
- ErrHandler.Init(@ErrDisplay);
-
- ClrScr;
- Writeln('Creating a file called TEST1.DAT');
-
- { init the file passing it the error handler and }
- { address of our data buffer }
- F.Init('TEST1.DAT', @ErrHandler, @Buff, SizeOf(Buff));
-
- { the first thing to do is define the keys }
- { key is name, it is an lString, modifiable, has duplicates }
- { and is left justified and padded }
- F.AddKeySegment(1, 31, bExtended + bDuplicates + bModifiable,
- bLstring, 0, bLJustify);
- { key is number, it is an lString, and is right justified }
- F.AddKeySegment(32, 6, bExtended, bLstring, 0, bRJustify);
- { now that all the keys are defined lets create and open it }
- { it will have no special features, but will overwrite any existing one }
- F.Create(bNormal, SizeOf(Buff), 1024, 0, bNormal);
- F.Open(bNormal, '');
-
- { lets add a couple records }
- Buff.Name := 'AAAAAAAAAA';
- Buff.Number := '1'; { the object will right justify this }
- Buff.Comment:= 'Record #1';
- F.Insert;
- Write('Adding some records .');
- Delay(500);
-
- Buff.Name := 'BBBBBBBBBB';
- Buff.Number := '2';
- Buff.Comment:= 'Record #2';
- F.Insert;
- Write('.');
- Delay(500);
-
- Buff.Name := 'CCCCCCCCCC';
- Buff.Number := '3';
- Buff.Comment:= 'Record #3';
- F.Insert;
- Write('.');
- Delay(500);
-
- Buff.Name := 'DDDDDDDDDD';
- Buff.Number := '4';
- Buff.Comment:= 'Record #4';
- F.Insert;
- Write('.');
- Delay(500);
-
- Buff.Name := 'EEEEEEEEEE';
- Buff.Number := '5';
- Buff.Comment:= 'Record #5';
- F.Insert;
- Writeln('.');
-
- { let's see how big the file is }
- Writeln('There are ', F.NumberOfRecords, ' records in the file.');
- Writeln('Press a key...');
- ReadKey;
-
- Writeln('Reading by key, should generate an error #4 and test error trapping');
- Writeln('Press a key...');
- ReadKey;
- { remember keys start at zero }
- F.SetKeyPath(1);
- { build the key, we'll try out the error handler and won't set up a match }
- Number := '9'; { no need to right justify this }
- F.MakeKey(@Number, nil, nil, nil, nil, nil);
- { read it without locks }
- F.Get(bGetEqual, bNoLock);
-
- { okay no we'll remove error key not found from from the trapped set }
- { and handle it ourselves }
- Writeln('Reading by the second key again, this time without error trapping');
- ErrHandler.RemoveErrors([bKeyNotFound]);
- F.Get(bGetEqual, bNoLock);
- Writeln('File status = ', F.bResult);
- Writeln('Press a key...');
- ReadKey;
-
- { put key not found back in }
- ErrHandler.AddErrors([bKeyNotFound]);
- { try a key that should be in the file }
- Writeln('Reading by the second key yet again');
- Number := '3';
- F.MakeKey(@Number, nil, nil, nil, nil, nil);
- F.Get(bGetEqual, bNoLock);
-
- if (F.bResult = bOkay) then
- begin
- Writeln('I think I got one');
- end
-
- else
- begin
- Writeln('Something is wrong?');
- Halt;
- end;
-
- { read and save the current file position }
- Pos := F.GetPosition;
- Writeln(Buff.Name);
- Writeln(Buff.Number);
- Writeln(Buff.Comment);
- Writeln('Current file positioning is ', Pos);
- Writeln('Press a key...');
- ReadKey;
-
- { Change it and write it back out }
- Writeln('Changing that last record');
- Buff.Comment := 'THIS RECORD HAS BEEN UPDATED!';
- F.Update;
- Writeln('Press a key...');
- ReadKey;
-
- { read and display a record by position and see that it changed }
- Writeln('Reading that last record by position');
- Writeln('Here is a record in the file at position ', F.GetPosition);
- F.GetDirect(bNoLock, Pos);
- Writeln(Buff.Name);
- Writeln(Buff.Number);
- Writeln(Buff.Comment);
- Writeln('Press a key...');
- ReadKey;
-
- { read and display the next record }
- F.Get(bGetNext, bNoLock);
- Writeln('Here is the next record in the file');
- Writeln(Buff.Name);
- Writeln(Buff.Number);
- Writeln(Buff.Comment);
- Writeln('Press a key...');
- ReadKey;
-
- { read and display the first record }
- Writeln('Here is the first record in the file');
- F.Get(bGetFirst, bNoLock);
- Writeln(Buff.Name);
- Writeln(Buff.Number);
- Writeln(Buff.Comment);
- Writeln('Press a key...');
- ReadKey;
-
-
- { Show the btrieve version }
- F.Version(Major, Minor, Flag);
- Writeln('You are running BTRIEVE version ', Major, '.', Minor, ' ', Flag);
- Writeln('Press a key...');
- ReadKey;
-
-
- F.Close;
- end.