FDCFastTextFile.pas - Text File Device Driver example

unit FDCFastTextFile;
/// <summary> A subset of the FDCTextFileTools, written by Lars Fosdal, way back when.</summary>
interface
uses
  Windows, SysUtils;

const
  UserDataSize = 32;
  MaxTxtBufSize      = 1024*1024*1024;
  FastTextFlushTreshold  = 512;


TYPE
  pFile = ^File; {Pointer to a binary file}
  pFastTextRec = ^RFastTextRec; {TTextRec.UserData type cast}
  RFastTextRec = PACKED RECORD
    DataFile : pFile;    {Pointer to the "text" file}
    Unused : ARRAY[SizeOf(pFile)+1..UserDataSize] OF Byte; {not used}
  END; {REC RFastTextRec}

PROCEDURE AssignFastText(VAR F:Text; Name:String; BufferSize:Integer; const CodePage: Word = CP_UTF8);

function FixSize (var f; NewSize : longint) : word;
function OpenOutFile (var f; path : string; Create, ResetSize : boolean) : word;

implementation

function FixSize (var f; NewSize : longint) : word;
  var
    Handle : word absolute f;
    fil : file absolute f;
    rc : integer;
  begin
  {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
    rewrite(fil, 1);
    rc := ioresult;
    if rc <> 0
    then begin
      FixSize := rc;
      exit;
    end;
    reset(fil, 1);
    rc := ioresult;
    FixSize := rc;
  {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
  end; {FixSize}



function OpenOutFile (var f; path : string; Create, ResetSize : boolean) : word;
  var
    fm      : Byte;
    fil     : file absolute f;
    iores   : integer;
  begin
    fm:=FileMode;
    filemode := $42;
    assign (fil, path);
  {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
    reset (fil, 1);
  {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
    iores := ioresult;
    if iores <> 0
    then begin
      if not Create
      then begin
        OpenOutFile := iores;
        FileMode:=fm;
        exit;
      end;
    {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
      rewrite (fil, 1);
    {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
      iores := ioresult;
      if iores <> 0
      then begin
        OpenOutFile := iores;
        FileMode:=fm;
        exit;
      end;
    {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
      reset (fil, 1);          { Filemode: 2 -> $42 }
    {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
      iores := ioresult;
      if iores <> 0
      then begin
        OpenOutFile := iores;
        FileMode:=fm;
        exit;
      end;
    end;
    if ResetSize
    then begin
      OpenOutFile := FixSize (fil, 0);
    end
    else OpenOutFile := 0;
    FileMode:=fm;
  end; {OpenOutFile}



FUNCTION FastTextRead(VAR F:TTextRec):Integer; FAR;
{ - Called by Read, ReadLn, Eof, Eoln, SeekEof, SeekEoln}
BEGIN
  BlockRead(RFastTextRec(F.UserData).DataFile^, F.BufPtr^, F.BufSize, F.BufEnd);
  F.BufPos:=0;
  FastTextRead:=IOResult; {Return BlockRead IO result}
END; {FUNC FastTextRead}

FUNCTION FastTextWrite(VAR F:TTextRec):Integer; FAR;
{ - Called by Write, Writeln, Close, and also by fmOutput mode flush}
BEGIN
  BlockWrite(RFastTextRec(F.UserData).DataFile^, F.BufPtr^, F.BufPos);
  F.BufPos:=0;
  FastTextWrite:=IOResult; {Return BlockWrite IO result}
END; {FUNC FastTextWrite}

FUNCTION FastTextWriteFlush(VAR F:TTextRec):Integer; FAR;
{ - Flush text buffer to disk}
BEGIN
  IF (F.BufSize-F.BufPos) < FastTextFlushTreshold
  THEN FastTextWriteFlush:=FastTextWrite(F) {Write flush}
  ELSE FastTextWriteFlush:=0;
END; {FUNC FastTextWriteFlush}

FUNCTION FastTextOpen(VAR F:TTextRec):Integer; FAR;
{ - Called by Reset, Append, or Rewrite}
VAR
  FastText : pFastTextRec;
  fm : Byte;
  IORes : Word;
BEGIN
  IORes:=0;
  FastText:=@F.UserData;
  IF not Assigned(F.BufPtr)
  THEN GetMem(F.BufPtr, F.BufSize);   {Allocate buffer}
  IF not Assigned(FastText^.DataFile)
  THEN New(FastText^.DataFile);     {Make space for the device driver file}
  AssignFile(FastText^.DataFile^, F.Name);  {and assign the file name to it}
  CASE F.Mode OF        {The ,1 indicates a 1 byte block size}
    fmInput  : BEGIN
      fm:=FileMode;
      FileMode:=0;
      Reset(FastText^.DataFile^, 1);
      IORes:=IOResult;
      F.InOutFunc:=@FastTextRead;
      F.FlushFunc:=nil;
      FileMode:=fm;
    END;
    fmInOut  : BEGIN {fmInOut is passed by Append}
      IORes:=OpenOutFile(FastText^.DataFile^, F.Name, False, False);
      IF IORes=0
      THEN BEGIN
        Seek(FastText^.DataFile^, FileSize(FastText^.DataFile^));  {Position for write}
        IORes:=IOResult;
      END;
      F.Mode:=fmOutput; {Switch to write mode}
      F.InOutFunc:=@FastTextWrite;
      F.FlushFunc:=@FastTextWriteFlush;
    END;
    fmOutput : BEGIN
      IORes:=OpenOutFile(FastText^.DataFile^, F.Name, True, True);
      F.InOutFunc:=@FastTextWrite;
      F.FlushFunc:=@FastTextWriteFlush;
    END;
  END;
  F.BufPos:=0; {Reset buffer indexes}
  F.BufEnd:=0;
  FastTextOpen:=IORes; {Return IO result from Reset, Rewrite or Append}
END;

FUNCTION FastTextClose(VAR F:TTextRec):Integer; FAR;
{ - Close encrypted "text" file}
VAR
  FastText : pFastTextRec;
BEGIN
  FastText:=@F.UserData;
  Close(FastText^.DataFile^);
  Dispose(FastText^.DataFile);
  FastText^.DataFile:=nil;
  FreeMem(F.BufPtr, F.BufSize);
  F.BufPtr:=nil;
  FastTextClose:=IOResult;
END; {FUNC FastTextClose}

PROCEDURE AssignFastText(VAR F:Text; Name:String; BufferSize:Integer; const CodePage: Word);
{ - Assign a text file to the encryption device driver}
VAR
  TRec : TTextRec Absolute F;
BEGIN
  FillChar(TRec, SizeOf(TRec), 0); {Clean out the TTextRec}
  TRec.CodePage := CodePage;
  TRec.OpenFunc:=@FastTextOpen;      {Assign the device driver functions}
  TRec.InOutFunc:=nil;
  TRec.FlushFunc:=nil;
  TRec.CloseFunc:=@FastTextClose;
  TRec.Mode:=fmClosed;             {Initial file mode must be closed}
  TRec.BufSize:=BufferSize;        {Init the buffer size}
  StrPCopy(TRec.Name, Name);       {and the filename}
  IOResult;
  SetLineBreakStyle(F, tlbsCRLF);
END; {PROC AssignFastText}


end.