Asynchronous File

unit xfile;

{$I cubix.inc}

interface

uses
  Windows,
  Messages,
  WinSock,
  SysUtils,
  Classes;

const
  MAX_BUFFER = 1024 * 32;

type
  TFileReadEvent = procedure(Sender: TObject; const Buffer; Count: Integer) of object;

  TAsyncFile = class
  private
    FHandle: THandle;
    FPosition: Cardinal;
    FReadPending: Boolean;
    FOverlapped: TOverlapped;
    FBuffer: Pointer;
    FBufferSize: Integer;
    FOnRead: TFileReadEvent;
    FEof: Boolean;
    FSize: Integer;
    function ProcessIo: Boolean;
    procedure DoOnRead(Count: Integer);
    function GetOpen: Boolean;
  public
    constructor Create(Filename: string; BufferSize: Integer = MAX_BUFFER);
    destructor Destroy; override;
    procedure BeginRead;
    procedure Seek(Position: Integer);
    procedure Close;
    property OnRead: TFileReadEvent read FOnRead write FOnRead;
    property Eof: Boolean read FEof;
    property IsOpen: Boolean read GetOpen;
    property Size: Integer read FSize;
  end;

function ProcessFiles: Boolean;

implementation

var
  Files: TList;

function ProcessFiles: Boolean;
var
  i: Integer;
  AsyncFile: TAsyncFile;
begin
  Result := False;
  for i := Files.Count - 1 downto 0 do
  begin
    AsyncFile := TAsyncFile(Files[i]);
    Result := AsyncFile.ProcessIo or Result;
  end;
end;

procedure Cleanup;
var
  i: Integer;
  AsyncFile: TAsyncFile;
begin
  for i := Files.Count - 1 downto 0 do
  begin
    AsyncFile := TAsyncFile(Files[i]);
    AsyncFile.Free;
  end;
  Files.Free;
end;

{ TAsyncFile }

constructor TAsyncFile.Create(Filename: string; BufferSize: Integer);
begin
  Files.Add(Self);
  FReadPending := False;
  FBufferSize := BufferSize;
  GetMem(FBuffer, FBufferSize);
  FillMemory(@FOverlapped, SizeOf(FOverlapped), 0);

  Cardinal(FHandle) := CreateFile(
                  PChar(Filename),         // file to open
                  GENERIC_READ,            // open for reading
                  0,                       // do not share
                  nil,                     // default security
                  OPEN_EXISTING,           // open existing
                  FILE_ATTRIBUTE_NORMAL, //or // normal file
                  //FILE_FLAG_OVERLAPPED,    // asynchronous I/O
                  0);                      // no attr. template

  FSize := FileSeek(FHandle, 0, soFromEnd);
  FileSeek(FHandle, 0, soFromBeginning);
  FPosition := 0;
end;

destructor TAsyncFile.Destroy;
begin
  Files.Remove(Self);
  CloseHandle(FHandle);
  FreeMem(FBuffer);
  inherited;
end;

function TAsyncFile.ProcessIo: Boolean;
var
  ReadCount: Cardinal;
begin
  Result := False;  Exit;
  if not FReadPending then
  begin
    Exit;
  end;

  if GetOverlappedResult(FHandle, FOverlapped, ReadCount, False) then
  begin
    FReadPending := False;
    DoOnRead(ReadCount);
  end
  else
  begin
    case GetLastError() of
      ERROR_HANDLE_EOF:
      begin
        FReadPending := False;
        FEof := True;
      end;
      ERROR_IO_PENDING:
      begin
        FReadPending := True;
      end;
      0:
      begin
        Result := True;
      end;
    end;
  end;
end;

procedure TAsyncFile.BeginRead;
var
  ReadResult: Boolean;
  ReadCount: Cardinal;
begin
  ReadCount := 0;
  Seek(FPosition);
  ReadResult := ReadFile(FHandle, FBuffer^, FBufferSize, ReadCount, nil);//@FOverlapped);
  if ReadResult then
  begin
    FEof := False;
    FReadPending := False;
    FPosition := FPosition + ReadCount;
    DoOnRead(ReadCount);
  end
  else
  begin
    case GetLastError() of
      ERROR_HANDLE_EOF:
      begin
        FReadPending := False;
        FEof := True;
      end;
      ERROR_IO_PENDING:
      begin
        FReadPending := True;
      end;
    end;
  end;
end;

procedure TAsyncFile.DoOnRead(Count: Integer);
begin
  if Assigned(FOnRead) then
  begin
    FOnRead(Self, FBuffer^, Count);
  end;
end;

function TAsyncFile.GetOpen: Boolean;
begin
  Result := Integer(FHandle) >= 0;
end;

procedure TAsyncFile.Close;
begin
  FileClose(FHandle);
end;

procedure TAsyncFile.Seek(Position: Integer);
begin
  FPosition := Position;
  FileSeek(FHandle, Position, soFromBeginning);
end;

initialization
  Files := Tlist.Create;

finalization
  Cleanup;

end.