unit DataFilUnit;
{TP6, TP7+BP7}
(* This is an EASY TO USE unit for data files with "homebrew"
records. It is not compatible to ANY kind of database
standards, but it is useful for smaller Pascal programs,
which need some data handling on files with records.
Data files consist of records, as defined in the Type declaration
of the Pascal program. The record #0 is used internally, it
contains only 1 longint. The remaining space in record #0 is
filled with 00 bytes and can be used otherwise. The payload
records are numbered from 1 to nnnnn?
Important: Your record must have a longint at the first 4 bytes.
This is 0 on valid records and non-0 on erased records. It is
maintained by the methods automatically, you need not modify
it. You can test it for a valid (non-erased) record.
The type of the used record need not be "known" in this unit,
so there is no problem with the units tree. The DataFileUnit
can be invoked first or very early in the uses clause of the
main program.
The unit can be used for a multiple of different data files,
if different instances of PDataFile are made.
It is suggested that the close procedure is programmed in the
data handling units with the ExitProc method, such that all
files are closed properly even in case of a program crash. This
makes it necessary that the PDataFile pointers are maintained
in static DS: RAM, not in the TApplication. In most cases it
is not necessary that the pointer is global, it can be declared
below the implementation keyword in the data handling unit.
Some procedures need an auxiliary record. This is not defined
as a local variable, to avoid stack overflow with large records.
But the programmer shall make sure that enough heap space is
still available for the auxiliary record.
The unit allows append and delete of records. The latest deleted
record will be used first, and only if all deleted records are
re-used, the filesize will be increased (appended).
The flush procedure shall be called frequently. You can interrogate
the FlushCnt variable, it displays how many records were appended
since the last flush. It is allowed to flush following each
AddRecord call.
The unit has no provisions for indexing or sorting. This must be
done with an index file (not recommended for simple applications)
or better with a TSortedCollection in RAM.
The methods are written as Functions with an integer result. It
shall be 0 normally, else it displays the IOresult or -1 for
Block-IO error. The critical variables are declared private, so
they cannot be modified by an outside unit.
There is no Constructor method, so you are responsible to call
the Open or Create method immediately after you "New" the object.
It is easy to use even for beginners, the usage of the object
oriented approach is displayed in the example application below.
The Filemode can be selected conforming to the rules of DOS,
for Network access etc. But this simple object has no record
locking mechanisms for concurrent access.
Note: The records on file are NOT sorted. They are placed on file
in a "random" manner. It is up to the program to maintain a sorted
list of keys to manage the data access, or a btree index or
another mechanism. In the appendix below you see an example of
a TSortedCollection for this purpose. A TListBox can be made to
display the key records on screen and get a selection bar.
--> This unit is especially dedicated to Pascal beginners, who shall
--> be forced to save their data professionally on file instead of
--> holding all records in a memory array.
NO GUARANTEE! The unit was extracted from a bigger unit, the code
here is not fully tested for completeness.
Franz Glaser *)
interface
uses DOS;
type
RecordBuffer = Record
Case Boolean of
false : (N : Longint;
d8 : Array[4..11] of Byte;
Sz : Word); {compatible with Turbo Access Toolbox TP4}
true : (Rc : Array[0..$FFF0] of Byte); {dummy}
End;
PDataFile = ^TDataFile;
TDataFile = Object {no virtual methods, static object}
F : file; {could be declared in the private section!}
IO,BlockIO : Integer;
FlushCnt : Integer; {is incremented whenever new recs are appended}
LastRecord : Longint; {convenience only, can be checked everywhere}
FN : PathStr; {convenience only}
Function Open(AFN:PathStr; ARecSiz:Word; OpenFM:Integer):Integer;
Function Create(AFN:PathStr; ARecSiz:Word; OpenFM:Integer):Integer;
Function Close : Integer; {must be called on program termination}
Function AddRecord(Var B; Var Rec:Longint):Integer;
Function DelRecord(Rec:Longint):Integer;
Function PutRecord(Var B; Rec:Longint):Integer;
Function GetRecord(Var B; Rec:Longint):Integer;
Function UnErase(Var B; Var Rec : Longint):Integer;
Function Flush:Integer; {shall be called after any nn addrecords}
Function GetRecSize : Word; {to hide critical variables}
Function GetLastErased : Longint;
Function GetOpenMode : Integer;
Private {variables can not be modified by other units}
RecSize : Word;
OpenMode : Integer;
AuxRec : ^RecordBuffer; {never used outside}
LastErased : Longint;
end;
Implementation
{Important: The TDataFile is a static object. It does not use virtual
methods. So it also has no .Init constructor. The programmer must
call the .Open immediately after New(...) to establish all necessary
setups to the variables. The Open method (and Create) perform the
setups}
Function TDataFile.Open(AFN:PathStr;ARecSiz:Word;OpenFM:Integer):Integer;
Var OldFM : Integer;
Begin
RecSize := 0;
Open := -1;
if ARecSiz < 16 then Exit;
FN := FExpand(AFN); {convenience data, for error msg etc.}
Assign(F,FN);
OpenMode := OpenFM;
OldFM := FileMode;
FileMode := OpenMode; {02H or 00H or 42H or 40H}
{$I-}
Reset(F,ARecSiz); {variable Recsize is not yet setup here}
{$I+}
FileMode := OldFM;
IO := IOresult;
Open := IO;
if IO <> 0 then Exit; {if IO-error, then result of .Open > 0}
GetMem(AuxRec,ARecSiz); {auxiliary record for internal use}
BlockRead(F,AuxRec^,1,BlockIO); {record #0}
if BlockIO <> 1 then
Begin
Open := -1;
FreeMem(AuxRec,ARecSiz);
Exit;
End;
LastErased := AuxRec^.N; {this was what I wanted to know}
if AuxRec^.Sz <> ARecSiz then
Begin
Open := -2;
FreeMem(AuxRec,ARecSiz); {the file was created}
Exit; { with another recsize}
End;
if LastErased=0 then {can be -1 or 1...nn}
Begin
LastErased := -1;
AuxRec^.N := LastErased;
Seek(F,0);
BlockWrite(F,AuxRec^,1,BlockIO);
{or optionally exit, some error occurred yesterday!}
End;
FreeMem(AuxRec,ARecSiz);
RecSize := ARecSiz; {mark as "open"}
FlushCnt := 0;
LastRecord := -1;
End;
{You shall not create a new file automatically whenever the original
file was not found. First ask the user, probably he/she has a backup
copy...}
Function TDataFile.Create(AFN:PathStr;ARecSiz:Word;OpenFM:Integer):Integer;
Var OldFM : Integer;
Begin
RecSize := 0;
Create := -1;
if ARecSiz < 4 then Exit;
FN := FExpand(AFN);
Assign(F,FN);
{$I-}
Rewrite(F,ARecSiz);
{$I+}
IO := IOresult;
Create := IO;
if IO <> 0 then Exit;
GetMem(AuxRec,ARecSiz);
Fillchar(AuxRec^,ARecSiz,#0);
AuxRec^.N := -1;
AuxRec^.Sz:= ARecSiz;
BlockWrite(F,AuxRec^,1,BlockIO);
FreeMem(AuxRec,ARecSiz);
{$I-}
System.Close(F); {on many OS the filemode does not work properly}
{$I+} {on new files. So it must be closed and re-opened}
IO := IOresult;
Create := IO;
if IO <> 0 then Exit;
if BlockIO <> 1 then
Begin
Create := -1;
Exit;
End;
OpenMode := OpenFM;
OldFM := FileMode;
FileMode := OpenMode;
{$I-}
Reset(F,ARecSiz);
{$I+}
FileMode := OldFM;
IO := IOresult;
Create := IO;
if IO <> 0 then Exit;
RecSize := ARecSiz;
FlushCnt := 0;
LastErased := -1;
LastRecord := -1;
End;
{the close procedure does not write to the file, so it does not need
an AuxRec to be obtained from the heap. This makes it especially
useful for the ExitProc approach}
Function TDataFile.Close : Integer;
Begin
Close := -1;
if RecSize = 0 then Exit;
{$I-}
System.Close(F);
{$I+}
IO := IOresult;
Close := IO;
RecSize := 0; {mark as "not open"}
End;
{Add a new record to the file. The procedure decides where to
write it and returns the record number used}
Function TDataFile.AddRecord(Var B;Var Rec:Longint):Integer;
{note: Rec is a result value here}
Var Buf : RecordBuffer absolute B; {"dirty" but powerful...}
Begin
AddRecord := -1; {preset as error}
if RecSize = 0 then Exit;
if (OpenMode and 2) = 0 then Exit; {opened in ReadOnly mode}
if LastErased = -1 then
Begin {no erased record available}
Rec := FileSize(F); {append}
Seek(F,Rec);
Buf.N := 0; {mark as "not erased" record}
BlockWrite(F,B,1,BlockIO);
if BlockIO = 1 then AddRecord := 0; {else -1 from above}
Inc(FlushCnt); {convenience counter}
LastRecord := Rec;
End
else
Begin {use latest erased record}
AddRecord := 0;
Rec := LastErased;
if (Rec < 1) or (Rec > FileSize(F)) then
Begin {obviously corrupted data area in the object}
AddRecord := -1;
Exit;
End;
Seek(F,Rec); {read the erased record to obtain the old link}
GetMem(AuxRec,RecSize); {auxiliary data record}
BlockRead(F,AuxRec^,1,BlockIO);
LastErased := AuxRec^.N; {update link list}
{$I-}
Seek(F,Rec);
{$I+}
IO := IOresult;
AddRecord := IO;
if IO <> 0 then
Begin
FreeMem(AuxRec,RecSize);
Exit;
End;
Buf.N := 0; {mark as valid again}
BlockWrite(F,B,1,BlockIO); {write the payload data to the erased rec}
if BlockIO <> 1 then
Begin
AddRecord := -1;
FreeMem(AuxRec,RecSize);
Exit;
End;
Seek(F,0); {should not need the ioresult stuff here}
BlockRead(F,AuxRec^,1,BlockIO);
AuxRec^.N := LastErased; {now update rec#0 with new link}
Seek(F,0);
BlockWrite(F,AuxRec^,1,BlockIO); {put into root}
FreeMem(AuxRec,RecSize);
LastRecord := Rec;
End;
End;
{marks a record as deleted and re-establishes the chain of
deleted records}
Function TDataFile.DelRecord(Rec:Longint):Integer;
Begin
DelRecord := -1;
if RecSize = 0 then Exit;
if (OpenMode and 2) = 0 then Exit; {opened in ReadOnly mode}
{$I-}
Seek(F,Rec);
{$I+}
IO := IOresult;
DelRecord := IO;
if IO <> 0 then Exit;
GetMem(AuxRec,RecSize);
BlockRead(F,AuxRec^,1,BlockIO);
if (BlockIO <> 1) or (AuxRec^.N <> 0) then {do not double erase}
Begin
DelRecord := -1;
FreeMem(AuxRec,RecSize);
Exit;
End;
AuxRec^.N := LastErased;
Seek(F,Rec);
BlockWrite(F,AuxRec^,1,BlockIO);
{$I-}
Seek(F,0);
{$I+}
IO := IOresult;
DelRecord := IO;
if IO <> 0 then
Begin
FreeMem(AuxRec,RecSize);
Exit;
End;
BlockRead(F,AuxRec^,1,BlockIO);
if BlockIO <> 1 then
Begin
DelRecord := -1;
FreeMem(AuxRec,RecSize);
Exit;
End;
LastErased := Rec;
AuxRec^.N := Rec;
Seek(F,0);
BlockWrite(F,AuxRec^,1,BlockIO);
FreeMem(AuxRec,RecSize);
LastRecord := Rec;
End;
{in most cases used to write a modified record back to disk}
Function TDataFile.PutRecord(Var B;Rec:Longint):Integer;
Var Buf : RecordBuffer absolute B;
Begin
PutRecord := -1;
if RecSize = 0 then Exit;
if (OpenMode and 2) = 0 then Exit; {opened in ReadOnly mode}
if (Rec < 1) or (Rec >= FileSize(F)) then Exit; {no ADD with PUT!}
Buf.N := 0; {make sure: "not erased"}
{$I-}
Seek(F,Rec);
{$I+}
IO := IOresult;
PutRecord := IO;
if IO <> 0 then Exit;
BlockWrite(F,B,1,BlockIO);
if BlockIO <> 1 then
PutRecord := -1;
LastRecord := Rec;
End;
{GetRecord can be used to read erased records too}
Function TDataFile.GetRecord(Var B;Rec:Longint):Integer;
Begin
GetRecord := -1;
if RecSize = 0 then Exit;
if (Rec < 1) or (Rec >= FileSize(F)) then Exit;
{$I-}
Seek(F,Rec);
{$I+}
IO := IOresult;
GetRecord := IO;
if IO <> 0 then Exit;
BlockRead(F,B,1,BlockIO);
if BlockIO <> 1 then
GetRecord := -1;
LastRecord := Rec;
End;
{auxiliary procedure to restore/UnErase the latest erased record}
Function TDataFile.UnErase(Var B; Var Rec : Longint):Integer;
{Rec is a result from the UnErase procedure}
Var Buf : RecordBuffer absolute B;
Begin
{calling program shall first ask the GetLastErased function if
there is a restorable record. if -1 then no erased record available}
UnErase := -1;
Rec := LastErased;
if Rec < 1 then Exit; {nothing to restore}
if RecSize = 0 then Exit; {already closed}
if (OpenMode and 2) = 0 then Exit; {opened in ReadOnly mode}
if Rec >= FileSize(F) then Exit; {must be an error}
{$I-}
Seek(F,Rec);
{$I+}
IO := IOresult;
UnErase := IO;
if IO <> 0 then Exit;
BlockRead(F,B,1,BlockIO);
if BlockIO <> 1 then
Begin
UnErase := -1;
Exit;
End;
LastErased := Buf.N; {get chain}
Buf.N := 0;
Seek(F,Rec);
BlockWrite(F,B,1,BlockIO); {write "unerased" record to file}
{now update the link in record #0:}
Seek(F,0);
GetMem(AuxRec,RecSize);
BlockRead(F,AuxRec^,1,BlockIO);
AuxRec^.N := LastErased; {update the chain}
Seek(F,0);
BlockWrite(F,AuxRec^,1,BlockIO);
FreeMem(AuxRec,RecSize);
LastRecord := Rec;
End;
Function TDataFile.Flush:Integer; {used to update DIR frequently}
Var Hand : Word;
Begin
Flush := -1;
if RecSize = 0 then Exit;
if (OpenMode and 2) = 0 then Exit; {no flush necessary on r/o files}
Hand := FileRec(F).Handle;
ASM
MOV BX,Hand
MOV AX,$6800 {there are no more DOS versions < 3.0 running...}
PUSH DS
PUSH BP
INT $21
POP BP
POP DS
JC @@1
MOV CX,0
@@1:
MOV Hand,CX {Result, auxiliary}
End;
FlushCnt := 0;
Flush := Hand;
End; {note: MSDOS < 3 had no such system call "commit file", needed
close and reopen or get a duplicate handle to close}
{the following functions are a means to read the critical variables
in the application units without the danger of corruption}
Function TDataFile.GetRecSize : Word;
Begin
GetRecSize := RecSize;
End;
Function TDataFile.GetLastErased : Longint;
Begin
GetLastErased := LastErased;
End;
Function TDataFile.GetOpenMode : Integer;
Begin
GetOpenMode := OpenMode;
End;
End. {of unit}
---------------------------------------------------------------
{ Application example for demo only, not compileable! }
Uses Objects,Views,Dialogs,MsgBox,App {...} ;
Type TPersRec = Record
Status : Longint; {THIS IS NECESSARY!!!}
FstName: String[47]; {the following items are free}
LstName: String[47];
Street : String[31];
PoCode : String[7];
City : String[31];
End;
PKeyRec = ^TKeyRec;
TKeyRec = Record
Name : String[35];
Rec : Longint; {40 bytes total, shall be mult of 8}
End;
{The TSortedCollection object is never used immediately. It is a
building block for your customized sorted collection}
PPersKeyCollection = ^TPersKeyCollection;
TPersKeyCollection = Object(TSortedCollection)
Constructor Init;
{the following 2 functions MUST be declared on any customized object:}
function Compare(Key1, Key2: Pointer): Integer; virtual;
procedure FreeItem(Item: Pointer); virtual;
End;
Var MyFile : PDataFile;
Pers : TPersRec;
Rc : Longint;
I : Integer;
Key : PKeyRec;
KeyCollection : PPersKeyCollection;
Constructor TPersKeyCollection.Init;
Begin
TSortedCollection.Init(64,32); {start with 64, increase by chunks of 32}
{suggestion: Init with the filesize of the datafile + some spare}
End;
function Compare(Key1, Key2: Pointer): Integer;
Begin
if PKeyRec(Key1)^.Name > PKeyRec(Key2)^.Name then
Compare := 1
else
Compare := -1; {this allows multiple occurrencies of the same key}
End;
procedure FreeItem(Item: Pointer);
Begin
FreeMem(Item,sizeof(TKeyRec));
End;
{. main ....}
Begin
MyFile := New(PDataFile);
with MyFile^ do
Begin
Case Open('PERSON.DAT',sizeof(TPersRec),$02) of
-2 : Begin Writeln('Record size does not fit: ',FN); Halt(3); End;
-1 : Begin Writeln('Error opening/reading file: ',FN); Halt(3); End;
0 : ;
2 : if MessageBox('Data file'^M^J+FN+^M^J'not found. Create new?',
Nil,mfError or mfYesNoCancel,hcMsgFileNotFound) = cmYes then
Begin
if Create('PERSON.DAT',sizeof(TPersRec),$02) <> 0 then
Halt(3);
End
else
Halt(4);
else
Begin
Writeln('could not open the person-file ',FN);
Writeln('Error #:',IO);
Halt(3);
End;
KeyCollection := New(PPersKeyCollection,Init);
if FileSize(F) > 1 then
for I := 1 to FileSize(F)-1 do
Begin
if GetRecord(Pers,I)=0 then
if Pers.Status=0 then
Begin
Key := New(PKeyRec);
Key^.Name := UpcaseStr(Pers.LstName);
{upcasestr not shown here}
Key^.Rec := I;
KeyCollection^.Insert(Key);
End;
End;
...
if KeyCollection^.Count > 0 then ....
End; {with}
{note: of course you can save your tsortedcollection to disk as a
stream. this avoids the necessity to read in the whole data file
every morning. the collection stream then behalves similar to an
index file}
...
if MyFile^.GetRecord(Pers,PKeyRec(KeyCollection^.At(Item))^.Rec) = 0 then
{note: Item is often derived from a MyListBox.Focused}
... {edit Pers record in a dialog window}
if MyFile^.PutRecord(Pers,PKeyRec(KeyCollection^.At(Item))^.Rec) = 0 then
... {write Pers back to file. Caution: do not allow the
user to modify the key strings, else it gets more
complicated: delete old key in the collection and
insert new key}
{new record: first edit a new, empty record, then add it to the file}
fillchar(Pers,sizeof(Pers),#0);
if EditPers(Pers) = cmOK then
if MyFile^.AddRecord(Pers,Rc) = 0 then
Begin
Key := New(PKeyRec);
Key^.Name := UpcaseStr(Pers.FstName); {very primitive key generation}
Key^.Rec := Rc; {result from AddRecord}
KeyCollection^.Insert(Key); {will sort it in: TSortedCollection}
{MyListBox^.SetRange(KeyCollection^.Count);
MyListBox^.FocusItem(KeyCollection^.InsertedAt);
MyListBox^.DrawView; }
if MyFile^.FlushCnt > 4 then
MyFile^.Flush;
End;
...
deleting:
{Again: Item is usually some MyListBox.Focused}
Key := KeyCollection^.At(Item);
if MyFile^.DelRecord(Key^.Rec) = 0 then
Begin
KeyCollection^.AtDelete(Item);
{MyListBox^.SetRange(KeyCollection^.Count);
MyListBox^.DrawView; }
End;
finally:
if MyFile^.Close <> 0 then; ...
Dispose(MyFile);
---------------------------------------------------------
You can use the remaining bytes of record #0 for
whatever you like.
---------------------------------------------------------
This version of DataFilUnit is compatible with the
Turbo Database Access Toolkit which was available for
Turbo Pascal 4 many years ago. The Database toolkit
also had btree index files, but I do not use it, I
prefer the TSortedCollection. The compatibility is
somewhat restricted, but you can use datafiles from a
toolbox (TP4 only, not TP3) program with this unit.
---------------------------------------------------------
Franz Glaser
http://members.eunet.at/meg-glaser
http://www.geocities.com/SiliconValley/2926/tp.html
meg-glaser@eunet.at
(
geocities.com/~franzglaser)