Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Asynchronous File

By: prog on Aug 17th, 2010  |  syntax: Delphi  |  size: 4.29 KB  |  views: 205  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. unit xfile;
  2.  
  3. {$I cubix.inc}
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows,
  9.   Messages,
  10.   WinSock,
  11.   SysUtils,
  12.   Classes;
  13.  
  14. const
  15.   MAX_BUFFER = 1024 * 32;
  16.  
  17. type
  18.   TFileReadEvent = procedure(Sender: TObject; const Buffer; Count: Integer) of object;
  19.  
  20.   TAsyncFile = class
  21.   private
  22.     FHandle: THandle;
  23.     FPosition: Cardinal;
  24.     FReadPending: Boolean;
  25.     FOverlapped: TOverlapped;
  26.     FBuffer: Pointer;
  27.     FBufferSize: Integer;
  28.     FOnRead: TFileReadEvent;
  29.     FEof: Boolean;
  30.     FSize: Integer;
  31.     function ProcessIo: Boolean;
  32.     procedure DoOnRead(Count: Integer);
  33.     function GetOpen: Boolean;
  34.   public
  35.     constructor Create(Filename: string; BufferSize: Integer = MAX_BUFFER);
  36.     destructor Destroy; override;
  37.     procedure BeginRead;
  38.     procedure Seek(Position: Integer);
  39.     procedure Close;
  40.     property OnRead: TFileReadEvent read FOnRead write FOnRead;
  41.     property Eof: Boolean read FEof;
  42.     property IsOpen: Boolean read GetOpen;
  43.     property Size: Integer read FSize;
  44.   end;
  45.  
  46. function ProcessFiles: Boolean;
  47.  
  48. implementation
  49.  
  50. var
  51.   Files: TList;
  52.  
  53. function ProcessFiles: Boolean;
  54. var
  55.   i: Integer;
  56.   AsyncFile: TAsyncFile;
  57. begin
  58.   Result := False;
  59.   for i := Files.Count - 1 downto 0 do
  60.   begin
  61.     AsyncFile := TAsyncFile(Files[i]);
  62.     Result := AsyncFile.ProcessIo or Result;
  63.   end;
  64. end;
  65.  
  66. procedure Cleanup;
  67. var
  68.   i: Integer;
  69.   AsyncFile: TAsyncFile;
  70. begin
  71.   for i := Files.Count - 1 downto 0 do
  72.   begin
  73.     AsyncFile := TAsyncFile(Files[i]);
  74.     AsyncFile.Free;
  75.   end;
  76.   Files.Free;
  77. end;
  78.  
  79. { TAsyncFile }
  80.  
  81. constructor TAsyncFile.Create(Filename: string; BufferSize: Integer);
  82. begin
  83.   Files.Add(Self);
  84.   FReadPending := False;
  85.   FBufferSize := BufferSize;
  86.   GetMem(FBuffer, FBufferSize);
  87.   FillMemory(@FOverlapped, SizeOf(FOverlapped), 0);
  88.  
  89.   Cardinal(FHandle) := CreateFile(
  90.                   PChar(Filename),         // file to open
  91.                   GENERIC_READ,            // open for reading
  92.                   0,                       // do not share
  93.                   nil,                     // default security
  94.                   OPEN_EXISTING,           // open existing
  95.                   FILE_ATTRIBUTE_NORMAL, //or // normal file
  96.                   //FILE_FLAG_OVERLAPPED,    // asynchronous I/O
  97.                   0);                      // no attr. template
  98.  
  99.   FSize := FileSeek(FHandle, 0, soFromEnd);
  100.   FileSeek(FHandle, 0, soFromBeginning);
  101.   FPosition := 0;
  102. end;
  103.  
  104. destructor TAsyncFile.Destroy;
  105. begin
  106.   Files.Remove(Self);
  107.   CloseHandle(FHandle);
  108.   FreeMem(FBuffer);
  109.   inherited;
  110. end;
  111.  
  112. function TAsyncFile.ProcessIo: Boolean;
  113. var
  114.   ReadCount: Cardinal;
  115. begin  
  116.   Result := False;  Exit;
  117.   if not FReadPending then
  118.   begin
  119.     Exit;
  120.   end;
  121.  
  122.   if GetOverlappedResult(FHandle, FOverlapped, ReadCount, False) then
  123.   begin
  124.     FReadPending := False;
  125.     DoOnRead(ReadCount);
  126.   end
  127.   else
  128.   begin
  129.     case GetLastError() of
  130.       ERROR_HANDLE_EOF:
  131.       begin
  132.         FReadPending := False;
  133.         FEof := True;
  134.       end;
  135.       ERROR_IO_PENDING:
  136.       begin
  137.         FReadPending := True;
  138.       end;
  139.       0:
  140.       begin
  141.         Result := True;
  142.       end;
  143.     end;
  144.   end;
  145. end;
  146.  
  147. procedure TAsyncFile.BeginRead;
  148. var
  149.   ReadResult: Boolean;
  150.   ReadCount: Cardinal;
  151. begin
  152.   ReadCount := 0;
  153.   Seek(FPosition);
  154.   ReadResult := ReadFile(FHandle, FBuffer^, FBufferSize, ReadCount, nil);//@FOverlapped);
  155.   if ReadResult then
  156.   begin
  157.     FEof := False;
  158.     FReadPending := False;
  159.     FPosition := FPosition + ReadCount;
  160.     DoOnRead(ReadCount);
  161.   end
  162.   else
  163.   begin
  164.     case GetLastError() of
  165.       ERROR_HANDLE_EOF:
  166.       begin
  167.         FReadPending := False;
  168.         FEof := True;
  169.       end;
  170.       ERROR_IO_PENDING:
  171.       begin
  172.         FReadPending := True;
  173.       end;
  174.     end;
  175.   end;
  176. end;
  177.  
  178. procedure TAsyncFile.DoOnRead(Count: Integer);
  179. begin
  180.   if Assigned(FOnRead) then
  181.   begin
  182.     FOnRead(Self, FBuffer^, Count);
  183.   end;
  184. end;
  185.  
  186. function TAsyncFile.GetOpen: Boolean;
  187. begin
  188.   Result := Integer(FHandle) >= 0;
  189. end;
  190.  
  191. procedure TAsyncFile.Close;
  192. begin
  193.   FileClose(FHandle);
  194. end;
  195.  
  196. procedure TAsyncFile.Seek(Position: Integer);
  197. begin
  198.   FPosition := Position;
  199.   FileSeek(FHandle, Position, soFromBeginning);
  200. end;
  201.  
  202. initialization
  203.   Files := Tlist.Create;
  204.  
  205. finalization
  206.   Cleanup;
  207.  
  208. end.
clone this paste RAW Paste Data