unit StreamFile; interface Uses SysUtils; Procedure AssignStreamFile (var F : Text ; Filename : String); implementation Const BufferSize = 128; Type TStreamBuffer = Array [1..High (Integer)] of Char;TStreamBufferPointer = ^TStreamBuffer; TStreamFileRecord = RecordCase Integer Of1:(Filehandle : Integer;Buffer : TStreamBufferPointer;BufferOffset : Integer;ReadCount : Integer;);2:(Dummy : Array [1 .. 32] Of Char)End; Function StreamFileOpen (var F : TTextRec) : Integer; VarStatus : Integer;BeginWith TStreamFileRecord (F.UserData) DoBeginGetMem (Buffer, BufferSize);Case F.Mode OffmInput:FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone);fmOutput:FileHandle := FileCreate (StrPas (F.Name));fmInOut:BeginFileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone OrfmOpenWrite or fmOpenRead); If FileHandle <> -1 Thenstatus := FileSeek (FileHandle, 0, 2); { Перемещаемся в конец файла. }F.Mode := fmOutput;End;End;BufferOffset := 0;ReadCount := 0;F.BufEnd := 0; { В этом месте подразумеваем что мы достигли конца файла (eof). }If FileHandle = -1 ThenResult := -1ElseResult := 0;End;End; Function StreamFileInOut (var F : TTextRec) : Integer; Procedure Read (var Data : TStreamFileRecord);Procedure CopyData;BeginWhile (F.BufEnd < Sizeof (F.Buffer) - 2)And (Data.BufferOffset <= Data.ReadCount)And (Data.Buffer [Data.BufferOffset] <> #10) DoBeginF.Buffer [F.BufEnd] := Data.Buffer^ [Data.BufferOffset];Inc (Data.BufferOffset);Inc (F.BufEnd);End;If Data.Buffer [Data.BufferOffset] = #10 ThenBeginF.Buffer [F.BufEnd] := #13;Inc (F.BufEnd);F.Buffer [F.BufEnd] := #10;Inc (F.BufEnd);Inc (Data.BufferOffset);End;End; Begin F.BufEnd := 0;F.BufPos := 0;F.Buffer := '';RepeatBeginIf (Data.ReadCount = 0) Or (Data.BufferOffset > Data.ReadCount) ThenBeginData.BufferOffset := 1;Data.ReadCount := FileRead (Data.FileHandle, Data.Buffer^, BufferSize);End;CopyData;End Until (Data.ReadCount = 0)Or (F.BufEnd >= Sizeof (F.Buffer) - 2);Result := 0;End; Procedure Write (var Data : TStreamFileRecord);VarStatus : Integer;Destination : Integer;II : Integer;BeginWith TStreamFileRecord (F.UserData) DoBeginDestination := 0;For II := 0 To F.BufPos - 1 DoBeginIf F.Buffer [II] <> #13 ThenBeginInc (Destination);Buffer^[Destination] := F.Buffer [II];End;End;Status := FileWrite (FileHandle, Buffer^, Destination);F.BufPos := 0;Result := 0;End;End;BeginCase F.Mode OffmInput:Read (TStreamFileRecord (F.UserData));fmOutput:Write (TStreamFileRecord (F.UserData));End;End; Function StreamFileFlush (var F : TTextRec) : Integer; BeginResult := 0;End; Function StreamFileClose (var F : TTextRec) : Integer; BeginWith TStreamFileRecord (F.UserData) DoBeginFreeMem (Buffer);FileClose (FileHandle);End;Result := 0;End; Procedure AssignStreamFile (var F : Text ; Filename : String); BeginWith TTextRec (F) DoBeginMode := fmClosed;BufPtr := @Buffer;BufSize := Sizeof (Buffer);OpenFunc := @StreamFileOpen;InOutFunc := @StreamFileInOut;FlushFunc := @StreamFileFlush;CloseFunc := @StreamFileClose;StrPLCopy (Name, FileName, Sizeof(Name) - 1);End;End;end. |