SHARE
TWEET

FDCFastTextFile.pas - Text File Device Driver example

LarsFosdal Dec 22nd, 2017 (edited) 214 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit FDCFastTextFile;
  2. /// <summary> A subset of the FDCTextFileTools, written by Lars Fosdal, way back when.</summary>
  3. interface
  4. uses
  5.   Windows, SysUtils;
  6.  
  7. const
  8.   UserDataSize = 32;
  9.   MaxTxtBufSize      = 1024*1024*1024;
  10.   FastTextFlushTreshold  = 512;
  11.  
  12.  
  13. TYPE
  14.   pFile = ^File; {Pointer to a binary file}
  15.   pFastTextRec = ^RFastTextRec; {TTextRec.UserData type cast}
  16.   RFastTextRec = PACKED RECORD
  17.     DataFile : pFile;    {Pointer to the "text" file}
  18.     Unused : ARRAY[SizeOf(pFile)+1..UserDataSize] OF Byte; {not used}
  19.   END; {REC RFastTextRec}
  20.  
  21. PROCEDURE AssignFastText(VAR F:Text; Name:String; BufferSize:Integer; const CodePage: Word = CP_UTF8);
  22.  
  23. function FixSize (var f; NewSize : longint) : word;
  24. function OpenOutFile (var f; path : string; Create, ResetSize : boolean) : word;
  25.  
  26. implementation
  27.  
  28. function FixSize (var f; NewSize : longint) : word;
  29.   var
  30.     Handle : word absolute f;
  31.     fil : file absolute f;
  32.     rc : integer;
  33.   begin
  34.   {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
  35.     rewrite(fil, 1);
  36.     rc := ioresult;
  37.     if rc <> 0
  38.     then begin
  39.       FixSize := rc;
  40.       exit;
  41.     end;
  42.     reset(fil, 1);
  43.     rc := ioresult;
  44.     FixSize := rc;
  45.   {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
  46.   end; {FixSize}
  47.  
  48.  
  49.  
  50. function OpenOutFile (var f; path : string; Create, ResetSize : boolean) : word;
  51.   var
  52.     fm      : Byte;
  53.     fil     : file absolute f;
  54.     iores   : integer;
  55.   begin
  56.     fm:=FileMode;
  57.     filemode := $42;
  58.     assign (fil, path);
  59.   {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
  60.     reset (fil, 1);
  61.   {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
  62.     iores := ioresult;
  63.     if iores <> 0
  64.     then begin
  65.       if not Create
  66.       then begin
  67.         OpenOutFile := iores;
  68.         FileMode:=fm;
  69.         exit;
  70.       end;
  71.     {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
  72.       rewrite (fil, 1);
  73.     {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
  74.       iores := ioresult;
  75.       if iores <> 0
  76.       then begin
  77.         OpenOutFile := iores;
  78.         FileMode:=fm;
  79.         exit;
  80.       end;
  81.     {$IFOPT I+} {$i-} {$DEFINE IPlus} {$ENDIF}
  82.       reset (fil, 1);          { Filemode: 2 -> $42 }
  83.     {$IFDEF IPlus} {$i+} {$UNDEF IPlus} {$ENDIF}
  84.       iores := ioresult;
  85.       if iores <> 0
  86.       then begin
  87.         OpenOutFile := iores;
  88.         FileMode:=fm;
  89.         exit;
  90.       end;
  91.     end;
  92.     if ResetSize
  93.     then begin
  94.       OpenOutFile := FixSize (fil, 0);
  95.     end
  96.     else OpenOutFile := 0;
  97.     FileMode:=fm;
  98.   end; {OpenOutFile}
  99.  
  100.  
  101.  
  102. FUNCTION FastTextRead(VAR F:TTextRec):Integer; FAR;
  103. { - Called by Read, ReadLn, Eof, Eoln, SeekEof, SeekEoln}
  104. BEGIN
  105.   BlockRead(RFastTextRec(F.UserData).DataFile^, F.BufPtr^, F.BufSize, F.BufEnd);
  106.   F.BufPos:=0;
  107.   FastTextRead:=IOResult; {Return BlockRead IO result}
  108. END; {FUNC FastTextRead}
  109.  
  110. FUNCTION FastTextWrite(VAR F:TTextRec):Integer; FAR;
  111. { - Called by Write, Writeln, Close, and also by fmOutput mode flush}
  112. BEGIN
  113.   BlockWrite(RFastTextRec(F.UserData).DataFile^, F.BufPtr^, F.BufPos);
  114.   F.BufPos:=0;
  115.   FastTextWrite:=IOResult; {Return BlockWrite IO result}
  116. END; {FUNC FastTextWrite}
  117.  
  118. FUNCTION FastTextWriteFlush(VAR F:TTextRec):Integer; FAR;
  119. { - Flush text buffer to disk}
  120. BEGIN
  121.   IF (F.BufSize-F.BufPos) < FastTextFlushTreshold
  122.   THEN FastTextWriteFlush:=FastTextWrite(F) {Write flush}
  123.   ELSE FastTextWriteFlush:=0;
  124. END; {FUNC FastTextWriteFlush}
  125.  
  126. FUNCTION FastTextOpen(VAR F:TTextRec):Integer; FAR;
  127. { - Called by Reset, Append, or Rewrite}
  128. VAR
  129.   FastText : pFastTextRec;
  130.   fm : Byte;
  131.   IORes : Word;
  132. BEGIN
  133.   IORes:=0;
  134.   FastText:=@F.UserData;
  135.   IF not Assigned(F.BufPtr)
  136.   THEN GetMem(F.BufPtr, F.BufSize);   {Allocate buffer}
  137.   IF not Assigned(FastText^.DataFile)
  138.   THEN New(FastText^.DataFile);     {Make space for the device driver file}
  139.   AssignFile(FastText^.DataFile^, F.Name);  {and assign the file name to it}
  140.   CASE F.Mode OF        {The ,1 indicates a 1 byte block size}
  141.     fmInput  : BEGIN
  142.       fm:=FileMode;
  143.       FileMode:=0;
  144.       Reset(FastText^.DataFile^, 1);
  145.       IORes:=IOResult;
  146.       F.InOutFunc:=@FastTextRead;
  147.       F.FlushFunc:=nil;
  148.       FileMode:=fm;
  149.     END;
  150.     fmInOut  : BEGIN {fmInOut is passed by Append}
  151.       IORes:=OpenOutFile(FastText^.DataFile^, F.Name, False, False);
  152.       IF IORes=0
  153.       THEN BEGIN
  154.         Seek(FastText^.DataFile^, FileSize(FastText^.DataFile^));  {Position for write}
  155.         IORes:=IOResult;
  156.       END;
  157.       F.Mode:=fmOutput; {Switch to write mode}
  158.       F.InOutFunc:=@FastTextWrite;
  159.       F.FlushFunc:=@FastTextWriteFlush;
  160.     END;
  161.     fmOutput : BEGIN
  162.       IORes:=OpenOutFile(FastText^.DataFile^, F.Name, True, True);
  163.       F.InOutFunc:=@FastTextWrite;
  164.       F.FlushFunc:=@FastTextWriteFlush;
  165.     END;
  166.   END;
  167.   F.BufPos:=0; {Reset buffer indexes}
  168.   F.BufEnd:=0;
  169.   FastTextOpen:=IORes; {Return IO result from Reset, Rewrite or Append}
  170. END;
  171.  
  172. FUNCTION FastTextClose(VAR F:TTextRec):Integer; FAR;
  173. { - Close encrypted "text" file}
  174. VAR
  175.   FastText : pFastTextRec;
  176. BEGIN
  177.   FastText:=@F.UserData;
  178.   Close(FastText^.DataFile^);
  179.   Dispose(FastText^.DataFile);
  180.   FastText^.DataFile:=nil;
  181.   FreeMem(F.BufPtr, F.BufSize);
  182.   F.BufPtr:=nil;
  183.   FastTextClose:=IOResult;
  184. END; {FUNC FastTextClose}
  185.  
  186. PROCEDURE AssignFastText(VAR F:Text; Name:String; BufferSize:Integer; const CodePage: Word);
  187. { - Assign a text file to the encryption device driver}
  188. VAR
  189.   TRec : TTextRec Absolute F;
  190. BEGIN
  191.   FillChar(TRec, SizeOf(TRec), 0); {Clean out the TTextRec}
  192.   TRec.CodePage := CodePage;
  193.   TRec.OpenFunc:=@FastTextOpen;      {Assign the device driver functions}
  194.   TRec.InOutFunc:=nil;
  195.   TRec.FlushFunc:=nil;
  196.   TRec.CloseFunc:=@FastTextClose;
  197.   TRec.Mode:=fmClosed;             {Initial file mode must be closed}
  198.   TRec.BufSize:=BufferSize;        {Init the buffer size}
  199.   StrPCopy(TRec.Name, Name);       {and the filename}
  200.   IOResult;
  201.   SetLineBreakStyle(F, tlbsCRLF);
  202. END; {PROC AssignFastText}
  203.  
  204.  
  205. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top