Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement