LarsFosdal

FDCFastTextFile.pas - Text File Device Driver example

Dec 22nd, 2017
259
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

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×