異步文件I /德爾福

Question

在此article delphi.net（棱鏡）支持異步文件IO O操作。 德爾福（本機/ VCL）也有異步文件IO類？

Answer 1

你見過這個代碼嗎？ http://pastebin.com/A2EERtyW

這對於異步文件I/O是一個很好的開始，但是我個人會在標準的TStream類中編寫一個包裝來維護與VCL/RTL的兼容性。

編輯2：這一個看起來很不錯了。 http://www.torry.net/vcl/filedrv/other/dstreams.zip

我只是萬一在這裏張貼從引擎收錄消失：

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. 

Answer 2

沒有什麼內置在RTL/VCL對於文件提供了異步I/O。順便提一下，Delphi Prism中的支持取決於.net框架，而不是基於語言。

您可以代碼直接對抗的Win32 API（這是不是很有趣），或到處尋找一個Delphi包裝該API。關於我的頭頂，我不知道任何異步文件I/O的Delphi包裝，但它們必須存在。