[Back to FILES SWAG index]  [Back to Main SWAG index]  [Original]

{ The following procedure physically removes record(s) from any file,
  then truncate the file. I use it to shrink log files and to remove
  index entries from Squish .SQI files, but many other uses may be found.  }

{ Donated to the public domain by Rapha‰l Vanney.                          }

Uses DOS ;

Function  DeleteRecs(    Var AFile ;
                         From      : LongInt ;
                         Count     : LongInt ;
                         BufSize   : Word) : Integer ;

{ AFile   : any typed or untyped file (not Text), must be opened           }
{ From    : number of 1st record to delete, 0-based                        }
{ Count   : number of record(s) to delete                                  }
{ BufSize : size of the buffer to allocate. Must be > record size          }

Var  Buffer    : Pointer ;              { pointer to buffer                }
     Src       : LongInt ;              { source record pointer            }
     Cnt       : LongInt ;              { scratch                          }
     Last      : LongInt ;              { last record to move              }
     f         : File Absolute AFile ;  { file we're going to work on      }
     Err       : Integer ;              { error code                       }

Label
     Sortie ;

Begin
     Last:=FileSize(f) ;
     Src:=From+Count ;
     If Count>(Last-From) Then Count:=Last-From ;

     { check BufSize against FileRec(f).RecSize }
     If (BufSize<FileRec(f).RecSize) Or
        (MaxAvail<BufSize) Then
     Begin
          DeleteRecs:=1 ; { error }
          Exit ;
     End ;

     GetMem(Buffer, BufSize) ;

     While Src<Last Do
     Begin
          Cnt:=BufSize Div FileRec(f).RecSize ;
          If (Src+Cnt)>Last Then Cnt:=Last-Src ;
          Seek(f, Src) ;
          BlockRead(f, Buffer^, Cnt) ;
          { error check }
          Err:=IOResult ;
          If Err<>0 Then GoTo Sortie ;
          Seek(f, From) ;
          BlockWrite(f, Buffer^, Cnt) ;
          { error check }
          Err:=IOResult ;
          If Err<>0 Then GoTo Sortie ;
          Inc(Src, Cnt) ;
          Inc(From, Cnt) ;
     End ;

     Seek(f, Last-Count) ;
     Truncate(f) ;
Sortie:
     DeleteRecs:=Err ;
     FreeMem(Buffer, BufSize) ;
End;

BEGIN
END.

[Back to FILES SWAG index]  [Back to Main SWAG index]  [Original]