[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {+--------------------------------------------------------------------------+
     | Class:       TLineStream
     | Created:     8.97
     | Author:      Martin Waldenburg
     | Copyright    1997, all rights reserved.
     | Description: TLineStream gives a buffered access to the lines of a
    file.
     |              Every line must end with CRLF. Don't forget to flush the
     |              Memory after writing.
     | Version:     1.2
     | State:       FreeWare
     | Disclaimer:
     | This is provided as is, expressly without a warranty of any kind.
     | You use it at your own risc.

    +--------------------------------------------------------------------------+}

    unit mwLineStream;

    interface

    uses
      SysUtils, Classes;

    type
      TLineStream = class(TFileStream)
      private
        fLineStart: PChar;
        fMaxMemorySize:Longint;
        fMaxLineSize:Longint;
        fMemorySize: LongInt;
        fLineSize:Longint;
        fMemory:PChar;
        fLine: PChar;
        fFileEof:Boolean;
        fMemoryPos: LongInt;
        fEof:Boolean;
        function GetMemoryFull:Boolean;
        procedure SetMaxLineSize(NewValue:Longint);
        procedure SetMaxMemorySize(NewValue:Longint);
      protected
      public
        constructor create(Const FileName: string;  Mode: Word);
        destructor destroy;override;
        procedure FillMemory;
        function ReadLine:PChar;
        procedure WriteLine(NewLine: String);
        procedure FlushMemory;
        procedure Reset;
        property MaxMemorySize:Longint read fMaxMemorySize write
    SetMaxMemorySize;
        property MaxLineSize:Longint read fMaxLineSize write SetMaxLineSize;
        property Memory:PChar read fMemory write fMemory;
        property MemoryFull:Boolean read GetMemoryFull;
        property FileEof:Boolean read fFileEof;
        property Eof:Boolean read fEof write fEof;
      published
      end;  { TLineStream }

    implementation

    constructor TLineStream.create(Const FileName: string;  Mode: Word);
    var
      fHandle: Integer;
    begin
      if not FileExists(FileName) then
        begin
          fHandle:= FileCreate(FileName);
          FileClose(fHandle);
        end;
      inherited create(FileName, Mode);
      fEof:= False;
      fFileEof:= False;
      MaxMemorySize:= 65535;
      fMemorySize:= 0;
      fMemoryPos:= 0;
      MaxLineSize:= 4096;
      Position:= 0;
    end;  { create }

    destructor TLineStream.destroy;
    begin
      ReallocMem(fMemory, 0);
      ReallocMem(fLine, 0);
      inherited destroy;
    end;  { destroy }

    procedure TLineStream.SetMaxMemorySize(NewValue:Longint);
    begin
      fMaxMemorySize:= NewValue;
      ReallocMem(fMemory, fMaxMemorySize +1);
    end; { SetMaxMemorySize }

    procedure TLineStream.SetMaxLineSize(NewValue:Longint);
    begin
      fMaxLineSize:= NewValue;
      ReallocMem(fLine, fMaxLineSize +1);
    end;  { SetMaxLineSize }

    procedure TLineStream.FillMemory;
    var
      Readed: LongInt;
    begin
      Readed:= Read(fMemory^, fMaxMemorySize);
      fMemorySize:= Readed;
      if Readed = 0 then fFileEof:= True;
      if fMemorySize > 0 then
      while fMemory[fMemorySize -2] <> #13 do  dec(fMemorySize);
      fMemory[fMemorySize]:= #0;
      Position:= Position -Readed + fMemorySize +1;
      fLineStart:= fMemory;
    end;   { FillMemory }

    function TLineStream.GetMemoryFull:Boolean;
    begin
      if fMemorySize > 0 then Result:= True else Result:= False;
    end;  { GetMemoryFull }

    function TLineStream.ReadLine:PChar;
    var
      Run: PChar;
    begin
      if (fMemorySize = 0) and not FileEof then FillMemory;
      if fMemorySize > 0 then
      begin
        Run:= fLineStart;
        while Run^ <> #13 do inc(Run);
        fLineSize:= Run - fLineStart;
        inc(Run, 2);
        StrLCopy(fLine, fLineStart, fLineSize);
        fLine[fLineSize]:= #0;
        Result:= fLine;
        fLineStart:= Run;
        Case Run^ of #0: FillMemory end;
      end;
      if fMemorySize = 0 then fEof:= True;
    end;   { ReadLine }

    procedure TLineStream.WriteLine(NewLine: String);
    var
      Count, Pos: Longint;
    begin
      NewLine:= NewLine + #13#10;
      Count:= Length(NewLine);
      if (fMemoryPos >= 0) and (Count >= 0) then
      begin
        Pos := fMemoryPos + Count;
        if Pos > 0 then
        begin
          if Pos > FMaxMemorySize then
            begin
               FlushMemory;
            end;
          StrECopy((fMemory + fMemoryPos), PChar(NewLine));
          fMemoryPos:= fMemoryPos + Count;
          fMemory[fMemoryPos]:= #0;
        end;
      end;
    end;  { WriteLine }

    procedure TLineStream.FlushMemory;
    begin
      Write(fMemory^, fMemoryPos);
      fMemoryPos:= 0;
    end;  { FlushMemory }

    procedure TLineStream.Reset;
    begin
      fEof:= False;
      fFileEof:= False;
      fMemorySize:= 0;
      fMemoryPos:= 0;
      Position:= 0;
    end;  { Reset }

    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]