{Read TextFile in Exclusive Mode.  Since Delphi only directly supports
 exclusive "reads" from typed or untyped files, this UNIT provides a
 way to read a TextFile in exclusive mode.

 Because of treatment of CR/LF characters, this class can be used to
 read either DOS files (CR+LF separators) or UNIX files (LF separator).

 If this UNIT is ever re-written, consider using Streams as described
 in the book "Secrets of Delphi 2," pp. 45-81

 Copyright (C) 1997, Earl F. Glynn, EFG Software, All Rights Reserved.
}

UNIT ExclusiveIO;

INTERFACE

  CONST
    BufferSize = 2048;

  TYPE
    TExclusiveIO =
      CLASS(TObject)
        PUBLIC
          CONSTRUCTOR Create;
          FUNCTION Open (CONST filename:  STRING):  BOOLEAN;
          FUNCTION Close:  BOOLEAN;
          FUNCTION EndOfFile:  BOOLEAN;
          FUNCTION GetLine:  STRING;

        PRIVATE
          Buffer   :  ARRAY[1..BufferSize] OF BYTE;
          BytesRead:  INTEGER;
          FileEnd  :  BOOLEAN;
          FileOpen :  BOOLEAN;
          Exclusive:  FILE;
          Position :  0..BufferSize;  {0 signifies invalid data in buffer}

          PROCEDURE ReadBlock;
          PROCEDURE CheckForBlockEnd;

      END;


IMPLEMENTATION

  USES
    SysUtils;  {FileExists}

  CONSTRUCTOR TExclusiveIO.Create;
  BEGIN
    INHERITED Create;
    FileEnd  := FALSE;
    FileOpen := FALSE;
    Position := 0;
  END {Create};


  PROCEDURE TExclusiveIO.ReadBlock;
  BEGIN
    {Do nothing if file is not open}
    IF  FileOpen
    THEN BEGIN

      TRY
        BlockRead(Exclusive, Buffer, SizeOf(Buffer), BytesRead);
        IF   BytesRead = 0
        THEN BEGIN
          Position := 0;
          FileEnd := TRUE;
          FileOpen := FALSE
        END
        ELSE Position := 1;
      EXCEPT
        On EInOutError DO
        BEGIN
          FileOpen := FALSE;
          Position := 0;
        END
      END;

    END
  END {ReadBlock};


  FUNCTION TExclusiveIO.Open (CONST filename:  STRING):  BOOLEAN;
    VAR
      SaveMode:  WORD;
  BEGIN
    IF   FileExists(filename)
    THEN BEGIN
      TRY
        SaveMode := System.FileMode;

        {"fmShareExclusive" guarantees that a file that is still open
         for writing will not be read until after it has been closed.
         This only works on typed or untyped files -- not TextFiles}
        System.FileMode := fmShareExclusive;
        AssignFile (Exclusive, filename);
        Reset (Exclusive, 1);   {Read 1-byte at a time}
        System.FileMode := SaveMode;
        FileOpen := TRUE
      EXCEPT
        On EInOutError DO
        BEGIN
          FileOpen := FALSE;
          FileEnd := TRUE
        END
      END;

      {If open was successful, go ahead and read first block}
      IF   FileOpen
      THEN ReadBlock;
    END
    ELSE FileOpen := FALSE;

    RESULT := FileOpen
  END {OpenFile};


  FUNCTION TExclusiveIO.Close:  BOOLEAN;
  BEGIN
    TRY
      CloseFile(Exclusive);
      FileOpen := FALSE;
      RESULT := TRUE;
    EXCEPT
      On EInOutError DO RESULT := FALSE
    END
  END {Closefile};


  FUNCTION TExclusiveIO.EndOfFile:  BOOLEAN;
  BEGIN
    RESULT := FileEnd  OR  (NOT FileOpen)
  END {EndOfFile};


  PROCEDURE TExclusiveIO.CheckForBlockEnd;
  BEGIN
    IF   position = BytesRead
    THEN
      IF   EOF(Exclusive)
      THEN BEGIN
        FileEnd := TRUE;
        position := 0;
      END
      ELSE ReadBlock
    ELSE INC(position)
  END {CheckForBlockEnd};


  FUNCTION TExclusiveIO.GetLine:  STRING;
  BEGIN
    RESULT := '';
    IF   FileOpen AND (position <> 0)
    THEN BEGIN

      {Accept characters from buffer until LF or CR are seen}
      WHILE (position > 0) AND
            (NOT (buffer[position] in [$0A, $0D])) DO
      BEGIN
        RESULT := RESULT + CHAR(buffer[position]);
        CheckForBlockEnd;  {Also increments/resets position}
      END;

      IF   position > 0
      THEN BEGIN
        {Treating CR and LF individually, allows this CLASS to be
         used with UNIX files with only LF separators instead of the
         usual CR LF separators.}

        IF   buffer[position] = $0D   {CR occurs first when present}
        THEN CheckForBlockEnd;

        IF   buffer[position] = $0A
        THEN CheckForBlockEnd;

      END

    END
  END {GetLine};


END.