Using WinInet functions to download a file asynchronously in Delphi

[转自]http://www.neugls.info/?p=191

(注：不好意思，如果你已经应用了该代码的话，请注意，在HttpQueryInfoA函数之前加上一个Reservered:=0;不然，会不能正确的获取到文件的大小。)

WinInet functions were used in windows to help developers develop network application more conveniently, but there is no Delphi code example on the internet, so I give some code here, help it useful for you.

Please first look at the following code:

type
  TNTDownLoadProgressCallBack = reference to procedure(Current,
    Total: Cardinal);
  TNTDownLoadFinishedCallBack = reference to procedure(Status: NativeInt);
  TNTShouldExit=reference to function():Boolean;

procedure DownLoadToFile(
              const URL, SavePath: string;
              ProgressCallBack: TNTDownLoadProgressCallBack;
              FinishCallBack: TNTDownLoadFinishedCallBack;
              CanExit:TNTShouldExit
           );
const
  USER_EXIT_DOWNLOAD_PROCESS=$666666;


implementation

uses 
{$IFDEF VER230}
        Winapi.Windows, System.SysUtils, Winapi.WinInet
{$ELSE}
        Windows, SysUtils,WinInet
{$ENDIF};



var
  Header: String = // 'GET %s HTTP/1.1'+sLineBreak+
    'Host: %s' + sLineBreak +
    'Connection: keep-alive' + sLineBreak +
    'User-Agent: NeuglsWorkStudio-Auto-updater' + sLineBreak +
    'Accept: text/html,application/xhtml+xml,application/*;q=0.9,*/*;q=0.8' +sLineBreak +
    'Accept-Encoding: gzip,deflate,sdch' + sLineBreak +
    'Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.3' + sLineBreak +
    'Accept-Language: *' + sLineBreak + 'Referer: http://neuglsworkstudio.com/';

var
  RequestHandle: HINTERNET;
  ConnetHandle: HINTERNET;

  ConnectEvent: THandle;
  RequestOpendEvent:THandle;
  RequestCompleteEvent: THandle;
  ShouldExit:Boolean;
  TheExitCode:Cardinal;

procedure InternetStatusCallback(hInt: HINTERNET; dwContext: DWORD_PTR;
    dwInternetStatus: DWORD; lpvStatusInformation: LPVOID;
    dwStatusInformationLength: DWORD); stdcall;
  var
    InternetAsyncResult: TInternetAsyncResult;
  begin
    case dwContext of
        1: if (dwInternetStatus = INTERNET_STATUS_HANDLE_CREATED) then
            begin
               InternetAsyncResult:=TInternetAsyncResult(lpvStatusInformation^);
               ConnetHandle:=Pointer(InternetAsyncResult.dwResult);
               SetEvent(ConnectEvent);
            end;
        2: case dwInternetStatus of
              INTERNET_STATUS_HANDLE_CREATED:
                begin
                  InternetAsyncResult:=TInternetAsyncResult(lpvStatusInformation^);
                  RequestHandle:=Pointer(InternetAsyncResult.dwResult);
                  SetEvent(RequestOpendEvent);
                end;
              INTERNET_STATUS_REQUEST_COMPLETE:
                begin
                  SetEvent(RequestCompleteEvent);
                end;
           end;
    end;
  end;

procedure DownLoadToFile(const URL, SavePath: string;
  ProgressCallBack: TNTDownLoadProgressCallBack;
  FinishCallBack: TNTDownLoadFinishedCallBack;
  CanExit:TNTShouldExit);
{$IFDEF MSWINDOWS}
const
  BufferSize = 1024*4;
var
  Session: HINTERNET;
  FHeader: AnsiString;
  dwReceived: Cardinal;
  Reservered: Cardinal;
  Buffer: PAnsiChar;
  dwBufferLength: Cardinal;
  BOK: Boolean;
  FileStream: TFileStream;
  InternetBuffer: TInternetBuffersA;
  CallBackPointer: PFNInternetStatusCallback;

  dwFileSize: Cardinal;
  dwSize,: Cardinal;
  I:Cardinal;


label
  ToExit;

  function GetHost(TheURL: string): String;
  var
    FURL: String;
  begin
    FURL := TheURL + '555';
    if pos(UpperCase('http://'), UpperCase(FURL)) > 0 then
    begin
      Delete(FURL, 1, Length('http://'));
    end;
    Result := Copy(FURL, 1, pos('/', FURL) - 1);
  end;

  function GetURI():string;
  var
    s:String;
  begin
    S:=GetHost(URL) ;
    Result := Copy(URL, pos(s, URL) + Length(s) + 1, MaxInt);
  end;


begin
  {Init the event}
  ConnectEvent:=CreateEvent(nil,false,false,'ConnectEvent');
  RequestCompleteEvent:=CreateEvent(nil,false,false,'RequestCompleteEvent');
  RequestOpendEvent:= CreateEvent(nil,false,false,'requestOpen');

  Session := InternetOpenA(PAnsiChar(AnsiString('NWSDownloader')),
    INTERNET_OPEN_TYPE_PRECONFIG, niL, niL, INTERNET_FLAG_ASYNC);
  if not Assigned(Session) then
    goto ToExit;

  CallBackPointer := @InternetStatusCallback;
  CallBackPointer := InternetSetStatusCallback(Session, CallBackPointer);
  if NativeInt(CallBackPointer) = INTERNET_INVALID_STATUS_CALLBACK then
    raise Exception.Create('callback function is not valid');

  ConnetHandle:=InternetConnectA(
                  Session,
                  PAnsiChar(AnsiString(GetHost(URL))),
                  INTERNET_DEFAULT_HTTP_PORT,
                  nil,
                  nil,
                  INTERNET_SERVICE_HTTP,
                  0,
                  1);
  if not Assigned(ConnetHandle) then
  begin
    if GetLastError=ERROR_IO_PENDING then
      WaitForSingleObject(ConnectEvent,INFINITE) //wait connection complete.
    else
      goto ToExit;
  end;

  RequestHandle:=HttpOpenRequestA(ConnetHandle,
                               PAnsiChar('GET'),
                               PAnsiChar(AnsiString(GetURI())),
                               nil,
                               nil,
                               nil,
                               INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE,
                               2);
  if not Assigned(RequestHandle) then
  begin
     if GetLastError=ERROR_IO_PENDING then
        WaitForSingleObject(RequestOpendEvent,INFINITE) //wait connection complete.
     else
      goto ToExit;
  end;




  FHeader := AnsiString(Format(Header, [GetHost(URL)]));
  if not HttpSendRequestA(RequestHandle,
                         PAnsiChar(FHeader),
                         SizeOf(AnsiChar)*Length(FHeader),
                         nil,
                         0)
  then
    if GetLastError<>ERROR_IO_PENDING then
       Goto ToExit;

  WaitForSingleObject(RequestCompleteEvent,INFINITE); //wait request complete.

  //get Content-Length
  dwFileSize:=0;
  dwSize:= Sizeof(dwFileSize);
  Reservered:=0;
  HttpQueryInfoA(
            RequestHandle,
            HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
            @dwFileSize,
            dwSize,Reservered
   );


  GetMem(Buffer, BufferSize);
  ZeroMemory(@InternetBuffer,SizeOf(InternetBuffer));
  FileStream := TFileStream.Create(SavePath, fmCreate);
  dwReceived := 0;
  I:=0;
  TheExitCode:=0;
  ShouldExit:=False;
  try

    while (True) do
    begin
      ZeroMemory(@InternetBuffer,SizeOf(InternetBuffer));
      InternetBuffer.dwStructSize := SizeOf(InternetBuffer);
      InternetBuffer.lpvBuffer := Buffer;
      InternetBuffer.dwBufferLength := BufferSize;

      ResetEvent(RequestCompleteEvent);
      Reservered:=1;
      BOK := InternetReadFileExA(RequestHandle, @InternetBuffer, IRF_NO_WAIT,
        Reservered);
      if BOK then
      begin
        Inc(I);
        FileStream.Write(Buffer^, InternetBuffer.dwBufferLength);
        ZeroMemory(Buffer, BufferSize);
        dwReceived := dwReceived + InternetBuffer.dwBufferLength;
        if I mod 3=0 then
          ProgressCallBack(dwReceived, dwFileSize);
      end
      else
      begin
        if GetLastError=ERROR_IO_PENDING then
          WaitForSingleObject(RequestCompleteEvent,INFINITE); //wait request complete.
      end;
      if (InternetBuffer.dwBufferLength=0) and(dwReceived=dwFileSize) then
        Break;
      if ShouldExit then
        Break;
      if CanExit then
      begin
        TheExitCode:=USER_EXIT_DOWNLOAD_PROCESS;
        Break;
      end;
    end;
  finally
    FreeMem(Buffer);
    FileStream.Free;
  end;
  InternetCloseHandle(RequestHandle);
  InternetCloseHandle(ConnetHandle);
  InternetSetStatusCallback(Session, nil);
  InternetCloseHandle(Session);
  FinishCallBack(TheExitCode);
  Exit;
ToExit:
  FinishCallBack(GetLastError);
  Exit;
{$ENDIF}
end;

If you want to know much more about why the code should like this, you may visit the following website pages:

• Using WinInet HTTP functions in Full Asynchronous Mode
• SAMPLE: How to Use AsyncHTTP to Call WinInet APIs Asynchronously