home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 11
/
CD_ASCQ_11_0294.iso
/
maj
/
558
/
example1.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-18
|
9KB
|
347 lines
{$X+}
{$V-}
{ EXAMPLE1.PAS - demonstrate file creation with multiple keys,
string justification, error trapping,
reading by key value, reading by file position
updating records
also indicates the platform, DOS, DPMI, Windows
uses a disk based message file
Requires Turbo Pascal version 6.0, 7.0
}
Uses
{$IFDEF WINDOWS}
WinCrt,
{$ELSE}
Crt,
{$ENDIF}
{$IFDEF VER70}
WinDos,
{$ELSE}
Dos,
{$ENDIF}
BtvConst,
Btv;
type
ErrorType = Object(ErrorDisplay)
Function Display(Error : Integer;
ErrorMsg : String;
OpCode : Integer;
OpCodeMsg : String;
FileName : PathStr
): ErrorAction; Virtual;
end;
var
F : BtrieveFile;
Buff : record
Name : String[15];
Number : String[5];
ZNumber : Array[0..15] of Char;
SNumber : Array[1..10] of Char;
Comment : String[80];
end;
Pos : LongInt;
Name : String[15];
Number : String[5];
ZNumber : Array[0..15] of Char;
ErrHandler : DiskErrorHandler;
ErrDisplay : ErrorType;
Major : Word;
Minor : Word;
Flag : Char;
i : Word;
{ Heres our error display object }
Function ErrorType.Display(Error : Integer;
ErrorMsg : String;
OpCode : Integer;
OpCodeMsg : String;
FileName : PathStr
): ErrorAction;
begin
ClrScr;
Writeln('Btrieve IO error for ' + FileName);
Writeln('ERROR CODE #', Error, ' - ', ErrorMsg);
Writeln('Press any key ....');
ReadKey;
Display := erDone; { just let the program continue }
ClrScr;
end;
begin
ClrScr;
{$IFDEF WINDOWS}
Writeln('COMPILED FOR WINDOWS');
{$ENDIF}
{$IFDEF DPMI}
Writeln('COMPILED FOR PROTECTED MODE');
{$ENDIF}
{$IFDEF MSDOS}
Writeln('COMPILED FOR REAL MODE');
{$ENDIF}
{ first make a error display }
ErrDisplay.Init;
{ make a DISK BASED error handler, it needs a display object }
ErrHandler.Init(@ErrDisplay, 'BTRIEVE.ERR');
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, 16, bExtended + bDuplicates + bModifiable,
bLstring, 0, bLJustify);
{ key is number, it is an lString, and is right justified }
F.AddKeySegment(17, 6, bExtended, bLstring, 0, bRJustify);
{ add a ZString segment }
F.AddKeySegment(23, 16, bExtended, bZstring, 0, bRJustify);
{ add a Btrieve String segment }
F.AddKeySegment(39, 10, bNormal, bString, 0, bLJustify);
{ 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 }
F.ClearBuffer;
Buff.Name := 'AAAAAAAAAA';
Buff.Number := '1'; { the object will right justify this }
Buff.ZNumber[0] := ' ';
Buff.ZNumber[1] := '1';
Buff.ZNumber[2] := #0;
Buff.SNumber[1]:= ' ';
Buff.SNumber[2]:= ' ';
Buff.SNumber[3]:= ' ';
Buff.SNumber[4]:= ' ';
Buff.SNumber[5]:= '1';
Buff.Comment:= 'Record #1';
F.Insert;
Write('Adding some records .');
{$IFNDEF WINDOWS}
Delay(50);
{$ENDIF}
F.ClearBuffer;
Buff.Name := 'BBBBBBBBBB';
Buff.Number := '2';
Buff.ZNumber[0] := '2';
Buff.ZNumber[1] := #0;
Buff.SNumber[1]:= ' ';
Buff.SNumber[2]:= ' ';
Buff.SNumber[3]:= ' ';
Buff.SNumber[4]:= ' ';
Buff.SNumber[5]:= ' ';
Buff.SNumber[6]:= ' ';
Buff.SNumber[7]:= ' ';
Buff.SNumber[8]:= ' ';
Buff.SNumber[9]:= ' ';
Buff.SNumber[10]:= '2';
Buff.Comment:= 'Record #2';
F.Insert;
Write('.');
{$IFNDEF WINDOWS}
Delay(50);
{$ENDIF}
F.ClearBuffer;
Buff.Name := 'CCCCCCCCCC';
Buff.Number := '3';
Buff.ZNumber[0] := ' ';
Buff.ZNumber[1] := ' ';
Buff.ZNumber[2] := ' ';
Buff.ZNumber[3] := ' ';
Buff.ZNumber[4] := ' ';
Buff.ZNumber[5] := ' ';
Buff.ZNumber[6] := ' ';
Buff.ZNumber[7] := ' ';
Buff.ZNumber[8] := ' ';
Buff.ZNumber[9] := ' ';
Buff.ZNumber[10] := ' ';
Buff.ZNumber[11] := ' ';
Buff.ZNumber[12] := ' ';
Buff.ZNumber[13] := ' ';
Buff.ZNumber[14] := '3';
Buff.ZNumber[15] := #0;
Buff.SNumber[1]:= '3';
Buff.Comment:= 'Record #3';
F.Insert;
Write('.');
{$IFNDEF WINDOWS}
Delay(50);
{$ENDIF}
F.ClearBuffer;
Buff.Name := 'DDDDDDDDDD';
Buff.ZNumber[0] := '4';
Buff.ZNumber[1] := #0;
Buff.SNumber[1]:= '4';
Buff.Number := '4';
Buff.Comment:= 'Record #4';
F.Insert;
Write('.');
{$IFNDEF WINDOWS}
Delay(50);
{$ENDIF}
F.ClearBuffer;
Buff.Name := 'EEEEEEEEEE';
Buff.Number := '5';
Buff.ZNumber[0] := '5';
Buff.ZNumber[1] := #0;
Buff.SNumber[1]:= '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 now 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 by ZString key }
F.SetKeyPath(2);
ZNumber[0] := '3';
ZNumber[1] := #0;
F.MakeKey(@ZNumber, nil, nil, nil, nil, nil);
F.Get(bGetEqual, bNoLock);
Writeln(Buff.Name);
Writeln(Buff.Number);
Writeln(' 123456789012345');
Write('<');
for i := 0 to 14 do
Write(Buff.ZNumber[i]);
Writeln('>');
Writeln(' 123456789012345');
Write('<');
for i := 1 to 10 do
Write(Buff.SNumber[i]);
Writeln('>');
Writeln(Buff.Comment);
Writeln('Current file positioning is ', Pos);
Writeln('Press a key...');
ReadKey;
F.SetKeyPath(1);
{ read and save the current file position }
Pos := F.GetPosition;
Writeln(Buff.Name);
Writeln(Buff.Number);
Writeln(' 123456789012345');
Write('<');
for i := 0 to 14 do
Write(Buff.ZNumber[i]);
Writeln('>');
Writeln(' 123456789012345');
Write('<');
for i := 1 to 10 do
Write(Buff.SNumber[i]);
Writeln('>');
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.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.