MajidTaheri
MajidTaheri

Reputation: 3983

async file I/O in Delphi

in this article delphi.net(prism) support async file io. Delphi(Native/VCL) has Async File IO Class too?

Upvotes: 4

Views: 2530

Answers (2)

Pateman
Pateman

Reputation: 2757

Have you seen this code? http://pastebin.com/A2EERtyW

It is a good start for ansynchronous file I/O, but personally I would write a wrapper around the standard TStream class to maintain compatibility with VCL/RTL.

EDIT 2: This one looks good, too. http://www.torry.net/vcl/filedrv/other/dstreams.zip

I am posting it here just in case it disappears from Pastebin:

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.

Upvotes: 3

David Heffernan
David Heffernan

Reputation: 613451

There is nothing built in to the RTL/VCL that offers asynchronous I/O for files. Incidentally the support in Delphi Prism is down to the .net framework rather than being language based.

You can either code directly against the Win32 API (that's not much fun) or hunt around for a Delphi wrapper to that API. Off the top of my head, I don't know any Delphi wrappers of asynchronous file I/O but they must exist.

Upvotes: 3

Related Questions