Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement