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