Wininet asynchronous download

[Inspur1]

Ich habe ein Beispiel gefunden und übersetzt
https://github.com/Codeh4ck/AsyncWin.../AsyncInet.cpp

Delphi-Quellcode:

//  < TAsyncInet >

uses WinInet, StrUtils;

type
  TAsyncInet = class;

  PINET_CONTEXT = ^INET_CONTEXT;
  INET_CONTEXT = record
    Obj: TAsyncInet;
    Context: DWORD;
  end;

  TRequestType = (
    _GET,
    _POST
  );

  TAsyncInet = class
  const
    CONTEXT_CONNECT = 0;
    CONTEXT_REQUESTHANDLE = 1;
  private
    FhConnectEvent: THandle;
    FhRequestOpenEvent: THandle;
    FhRequestCompleteEvent: THandle;
    FhOpen: HINTERNET;
    FhConnect: HINTERNET;
    FhRequest: HINTERNET;
    FContext: INET_CONTEXT;
  protected
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    function Connect(UserAgent, Host: string; Timeout: DWORD = 20000): Boolean;
    function SendRequest(RequestType: TRequestType; Url, RequestData,
      Referrer: string; Timeout: DWORD = 20000): Boolean;
    function ReadData(Buffer: Pointer; Size: DWORD; Timeout: DWORD = 20000): DWORD;
    procedure Disconnect;
  end;


constructor TAsyncInet.Create;
begin
  inherited;
  FhConnectEvent := CreateEvent(nil, false, false, nil);
  FhRequestOpenEvent := CreateEvent(nil, false, false, nil);
  FhRequestCompleteEvent := CreateEvent(nil, false, false, nil);

  FhOpen := nil;
  FhConnect := nil;
  FhRequest := nil;

  FContext.Obj := nil;
  FContext.Context := 0;
end;

destructor TAsyncInet.Destroy;
begin
  if FhConnectEvent > 0 then
    CloseHandle(FhConnectEvent);
  if FhRequestOpenEvent > 0 then
    CloseHandle(FhRequestOpenEvent);
  if FhRequestCompleteEvent > 0 then
    CloseHandle(FhRequestCompleteEvent);
  Disconnect;
  inherited;
end;

procedure StatusCallback(hInet: HINTERNET; dwContext: DWORD_PTR;
  dwInternetStatus: DWORD; lpvStatusInformation: Pointer;
  dwStatusInformationLength: DWORD); stdcall;
var
  pContext: PINET_CONTEXT;
  pConnectResult, pRequestResult: PINTERNET_ASYNC_RESULT;
begin
  pContext :=  PINET_CONTEXT(dwContext);
  case pContext^.Context of
    TAsyncInet.CONTEXT_CONNECT:
    begin
      if dwInternetStatus = INTERNET_STATUS_HANDLE_CREATED then
      begin
        pConnectResult := PINTERNET_ASYNC_RESULT(lpvStatusInformation);
        pContext^.Obj.FhConnect := HINTERNET(pConnectResult^.dwResult);
        SetEvent(pContext^.Obj.FhConnectEvent);
      end;
    end;
    TAsyncInet.CONTEXT_REQUESTHANDLE:
    begin
      case dwInternetStatus of
        INTERNET_STATUS_HANDLE_CREATED:
        begin
          pRequestResult := PINTERNET_ASYNC_RESULT(lpvStatusInformation);
          pContext^.Obj.FhRequest := HINTERNET(pRequestResult^.dwResult);
          SetEvent(pContext^.Obj.FhRequestOpenEvent);
        end;
        INTERNET_STATUS_REQUEST_COMPLETE:
        begin
          SetEvent(pContext^.Obj.FhRequestCompleteEvent);
        end;  
      end;
    end;
  end;
end;

function TAsyncInet.Connect(UserAgent, Host: string; Timeout: DWORD): Boolean;
begin
  result := false;
  Disconnect;
  ResetEvent(FhConnectEvent);
  ResetEvent(FhRequestOpenEvent);
  ResetEvent(FhRequestCompleteEvent);

  FhOpen := InternetOpen(PChar(UserAgent),
                         INTERNET_OPEN_TYPE_PRECONFIG,
                         nil,
                         nil,
                         INTERNET_FLAG_ASYNC);
  if FhOpen = nil then
    exit;

  if Boolean(InternetSetStatusCallback(FhOpen, INTERNET_STATUS_CALLBACK(@StatusCallback))) then
    exit;

  FContext.Context := TAsyncInet.CONTEXT_CONNECT;
  FContext.Obj := self;

  FhConnect := InternetConnect(FhOpen,
                               PChar(Host),
                               INTERNET_DEFAULT_PORT,
                               nil,
                               nil,
                               INTERNET_SERVICE_HTTP,
                               INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_DONT_CACHE,
                               DWORD(@FContext));

  if FhConnect = nil then
  begin
    if GetLastError = ERROR_IO_PENDING then
    begin
      if Boolean(WaitForSingleObject(FhConnectEvent, Timeout)) then
        exit;
    end;
    exit;
  end;

  if FhConnect = nil then
    exit;

  result := true;
end;

function TAsyncInet.SendRequest(RequestType: TRequestType; Url: string;
  RequestData, Referrer: string; Timeout: DWORD): Boolean;
var
  verb: string;
  requested: Boolean;
  header: string;
begin
  result := false;
  requested := false;

  FContext.Context := TAsyncInet.CONTEXT_REQUESTHANDLE;
  FContext.Obj := self;

  if RequestType = _GET then
    verb := 'GET'
  else if RequestType = _POST then
    verb := 'POST';

  FhRequest := HttpOpenRequest(FhConnect,
                               PChar(verb),
                               PChar(Url),  
                               nil,
                               PChar(Referrer),
                               nil,
                               INTERNET_FLAG_RELOAD or
                               INTERNET_FLAG_KEEP_CONNECTION or
                               INTERNET_FLAG_DONT_CACHE,
                               DWORD(@FContext));
  if FhRequest = nil then
  begin
    if GetLastError = ERROR_IO_PENDING then
    begin
      if Boolean(WaitForSingleObject(FhRequestOpenEvent, Timeout)) then
        exit;
    end;
  end;

  if FhRequest = nil then
    exit;

  if RequestType = _GET then
    requested := HttpSendRequest(FhRequest,
                                 nil,
                                 0,
                                 PChar(RequestData),
                                 Length(RequestData))
  else if RequestType = _POST then
  begin
    header := 'Content-Type: application/x-www-form-urlencoded';
    requested := HttpSendRequest(FhRequest,
                                 PChar(header),
                                 Length(header),
                                 PChar(RequestData),
                                 Length(RequestData));
  end;

  if not requested  then
  begin
    if GetLastError = ERROR_IO_PENDING then
    begin
      if WaitForSingleObject(FhRequestCompleteEvent, Timeout) = WAIT_TIMEOUT then
      begin
        Disconnect;
        exit;
      end;
    end;
  end;

  result := true;
end;

function TAsyncInet.ReadData(Buffer: Pointer; Size: DWORD; Timeout: DWORD): DWORD;
var
  inetBuffers: INTERNET_BUFFERS;
begin
  result := 0;
  ZeroMemory(@inetBuffers, SizeOf(INTERNET_BUFFERS));
  inetBuffers.dwStructSize := SizeOf(INTERNET_BUFFERS);
  inetBuffers.lpvBuffer := Buffer;
  inetBuffers.dwBufferLength := Size - 1;

  FContext.Context := TAsyncInet.CONTEXT_REQUESTHANDLE;
  FContext.Obj := self;

  if not InternetReadFileEx(FhRequest, inetBuffers, 0, DWORD(@FContext)) then
  begin
    if GetLastError = ERROR_IO_PENDING then
    begin
      if WaitForSingleObject(FhRequestCompleteEvent, Timeout) = WAIT_TIMEOUT then
        exit;
    end;
  end;

  result := inetBuffers.dwBufferLength;
end;

procedure TAsyncInet.Disconnect;
begin
  InternetCloseHandle(FhOpen);
  InternetCloseHandle(FhConnect);
  InternetCloseHandle(FhRequest);
  FhOpen := nil;
  FhConnect := nil;
  FhRequest := nil;
end;

//  < /TAsyncInet >

procedure ExtractUrlTo(const Url: string; var Host, Path: string);
var
  posLeft, posRight: Integer;
begin
  posLeft := Pos('//www.', Url) + 6;
  if posLeft = 6 then
  begin
    posLeft := Pos('//', Url) + 2;
    if posLeft = 2 then
    begin
      posLeft := Pos('www.', Url) + 4;
      if posLeft = 4 then
        posLeft := 1;
    end;
  end;

  posRight := StrUtils.PosEx('/', Url, posLeft);
  if posRight > 0 then
    Path := Copy(Url, posRight, Length(Url) - posRight + 1)
  else begin
    posRight := Length(Url) + 1;
    Path := '/';
  end;

  Host := Copy(Url, posLeft, posRight - posLeft);
end;

function DownloadAsync(const Url, FileName): Boolean;
const
  BUFFER_SIZE = 1024 * 4;
var
  inet: TAsyncInet;
  host, path: string;
  buff: array[0..BUFFER_SIZE - 1] of Byte;
  currentBytes: DWORD;
  f: File;
begin
  result := false;
  inet := TAsyncInet.Create;
  try
    ZeroMemory(@buff[0], BUFFER_SIZE);
    ExtractUrlTo(Url, host, path);
    if inet.Connect('Test', host) then
      if inet.SendRequest(_GET, path, '', '') then
      begin
        AssignFile(f, FileName);
        Rewrite(f, 1);
        repeat
          currentBytes := inet.ReadData(@buff, BUFFER_SIZE);
          buff[currentBytes] := 0;
          BlockWrite(f, buff, currentBytes);
        until currentBytes = 0;
        CloseFile(f);
        result := true;
      end;
  finally
    inet.Free;
  end;
end; 

// Call
var
  url, filename: string;
begin
  url := 'http://212.183.159.230/50MB.zip';
  filename := 'example.zip';
  DownloadAsync(url, filename); 
  ShowMessage('Finished!');
end;

Funktioniert, aber während Download ist Programm frozen, bis Download fertig ist.
Das sollte bei Async nicht passieren, oder?