xfile.pas

unit xfile;

{$I cubix.inc}

interface

uses
  Windows,
  Messages,
  WinSock,
  SysUtils,
  Classes,
  fifostream;

const
  MAX_BUFFER = 1024 * 4;

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

  TAsyncFile = class
  private
    FHandle: THandle;
    FOverlapped: TOverlapped;
    FBuffer: PByteArray;
    FOnRead: TFileReadEvent;
    FEof: Boolean;
    function ProcessIo: Boolean;
    procedure DoOnRead(Count: Integer);
    function GetOpen: Boolean;
  public
    constructor Create(Filename: string; FileMode: Integer = fmOpenRead; BufferSize: Integer = MAX_BUFFER);
    destructor Destroy; override;
    procedure BeginRead;
    procedure BeginWrite(var Buf; Size: Integer);
    property OnRead: TFileReadEvent read FOnRead write FOnRead;
    property Eof: Boolean read FEof;
    property Open: Boolean read GetOpen;
  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]);
    if AsyncFile.Open then
    begin
      AsyncFile.Free;
    end;
  end;
  Files.Free;
end;

{ TAsyncFile }

constructor TAsyncFile.Create(Filename: string; FileMode: Integer; BufferSize: Integer);
begin
  GetMem(FBuffer, BufferSize);
  FHandle := FileOpen(Filename, FileMode);
  FillMemory(@FOverlapped, SizeOf(FOverlapped), 0);
  FOverlapped.hEvent := CreateEvent(nil, True, False, nil);
  Files.Add(Self);
end;

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

function TAsyncFile.ProcessIo: Boolean;
var
  ReadCount: Cardinal;
begin
  Result := GetOverlappedResult(FHandle, FOverlapped, ReadCount, False);
  if Result then
  begin
    DoOnRead(ReadCount);
  end
  else if GetLastError() = ERROR_HANDLE_EOF then
  begin
    FEof := True;
  end;
end;

procedure TAsyncFile.BeginRead;
var
  ReadResult: Boolean;
  ReadCount: Cardinal;
begin
  ReadCount := 0;
  ReadResult := ReadFile(FHandle, FBuffer, SizeOf(FBuffer), ReadCount, @FOverlapped);
  if ReadResult then
  begin
    FEof := False;
    DoOnRead(ReadCount);
  end
  else if GetLastError() = ERROR_HANDLE_EOF then
  begin
    FEof := True;
  end;
end;

procedure TAsyncFile.BeginWrite(var Buf; Size: Integer);
begin

end;

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

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

initialization
  Files := Tlist.Create;

finalization
  Cleanup;

end.