Delphi，使用 WinInet 发布并跟踪上传进度

Question

相关 How to send a HTTP POST Request in Delphi using WinInet api :

我如何提出发布请求并跟踪进度？

这不起作用(检查评论):

procedure StatusCallback(
  hInet:        HINTERNET;
  Context:      DWORD_PTR;
  Status:       DWORD;
  pInformation: Pointer;
  InfoLength:   DWORD ); stdcall;
var
  s: string;
  c: Cardinal;
begin
  case Status of
    INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
    INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ';
    INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address';
    INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
    INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
    INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
    INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
    INTERNET_STATUS_INTERMEDIATE_RESPONSE: s :=
      'Received an intermediate (100 level) status code message from the server';
    INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PAnsiChar(pInformation);
    INTERNET_STATUS_PREFETCH: s := 'Not implemented';
    INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request ';
    INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
      PAnsiChar(pInformation);
    INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
    INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' +
      IntToStr(NativeUInt(pInformation)) + ' Byte';
    INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PAnsiChar(pInformation);
    INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server: ' +
      IntToStr(NativeUInt(pInformation)) + ' Byte';
    INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server.';
    INTERNET_STATUS_STATE_CHANGE:
      begin
        s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
        case DWORD(pInformation) of
          INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
          INTERNET_STATE_DISCONNECTED: s := s + #13#10 +
            'Disconnected state. No network connection could be established.';
          INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
          INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
          INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
        end;
      end;
  end;
  tss.Add(s);
end;

function Https_Post(var callSettings: httpCallSettings; xServer,xRes: string): Integer;
const
  BufferSize=1024*64;
var
  hInet    : HINTERNET;
  hConnect : HINTERNET;
  hRequest : HINTERNET;
  dwc: UInt64;
  ErrorCode : Integer;
  lpdwBufferLength: DWORD;
  lpdwReserved    : DWORD;
  dwBytesRead     : DWORD;
  lpdwNumberOfBytesAvailable: DWORD;
  heads: ansistring;
  header: TStringStream;
begin
tss := tstringlist.Create;
  Result   :=0;
  callSettings.Response :='';
  hInet    := InternetOpen(PChar(callSettings.uAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if hInet=nil then
  begin
    ErrorCode:=GetLastError;
    raise Exception.Create(Format('InternetOpen Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
  end;

  try
    hConnect := InternetConnect(hInet, PChar(xServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, dwc);
    if hConnect=nil then
    begin
      ErrorCode:=GetLastError;
      raise Exception.Create(Format('InternetConnect Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
    end;

    try
      hRequest := HttpOpenRequest(hConnect, 'POST', PChar(xRes), HTTP_VERSION, '', nil, INTERNET_FLAG_SECURE, dwc);
      if hRequest=nil then
      begin
        ErrorCode:=GetLastError;
        raise Exception.Create(Format('HttpOpenRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
      end;

      try

      Header := TStringStream.Create('');
      with Header do
        begin
          WriteString('Host: ' + xServer + sLineBreak);
          WriteString('User-Agent: '+ callSettings.uAgent + SLineBreak);
          WriteString('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'+SLineBreak);
          WriteString('Accept-Language: en-us,en;q=0.5' + SLineBreak);
          WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7'+SLineBreak);
          WriteString('Keep-Alive: 300'+ SLineBreak);
          if callSettings.ExtraHeader <> '' then WriteString(callSettings.ExtraHeader + SlineBreak);
          if callSettings.CType <> ''       then WriteString('Content-Type: ' + callSettings.cType + SlineBreak);
          WriteString('Connection: keep-alive'+ SlineBreak + SlineBreak);
        end;

        HttpAddRequestHeaders(hRequest, PChar(Header.DataString), Length(Header.DataString), HTTP_ADDREQ_FLAG_ADD);

        InternetSetStatusCallback( hRequest, @StatusCallback );

        //send the post request
        if not HTTPSendRequest(hRequest, nil, 0, @callSettings.postvars[1], Length(callSettings.postvars)) then
        begin
          ErrorCode:=GetLastError;
          raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
        end;

          lpdwBufferLength:=SizeOf(Result);
          lpdwReserved    :=0;
          //get the response code
          if not HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, lpdwBufferLength, lpdwReserved) then
          begin
            ErrorCode:=GetLastError;
            raise Exception.Create(Format('HttpQueryInfo Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
          end;

         CallSettings.CallStatus := Result;
         //if the response code =200 then get the body
         if Result=200 then
          if InternetQueryDataAvailable(hRequest, lpdwNumberOfBytesAvailable, 0, 0) then
          begin
            SetLength(callSettings.response,lpdwNumberOfBytesAvailable);
            InternetReadFile(hRequest, @callSettings.response[1], lpdwNumberOfBytesAvailable, dwBytesRead);
          end
          else
          begin
            ErrorCode:=GetLastError;
            raise Exception.Create(Format('InternetQueryDataAvailable Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
          end;

      finally
        InternetCloseHandle(hRequest);
      end;
    finally
      InternetCloseHandle(hConnect);
    end;
  finally
    InternetCloseHandle(hInet);
  end;
  showmessage(tss.Text);
end;

Answer 1

使用 InternetSetStatusCallback() 向 HTTP session 注册回调函数，以在请求操作的各个阶段接收状态信息。

请注意文档中的以下警告:

Note The callback function specified in the lpfnInternetCallback parameter will not be called on asynchronous operations for the request handle when the dwContext parameter of HttpOpenRequest is set to zero (INTERNET_NO_CALLBACK), or the connection handle when the dwContext handle of InternetConnect is set to zero (INTERNET_NO_CALLBACK).

尝试更多类似的东西:

function SockAddrToString(pAddr: LPSOCKADDR; AddrSize: DWORD): String;
var
  Buf: array[0..40] of Char;
  Len: DWORD;
begin
  Result := '';
  Len := Length(Buf);
  if WSAAddressToString(pAddr, AddrSize, nil, Buf, Len) = 0 then
    SetString(Result, Buf, Len-1);
end;

procedure StatusCallback(
  hInet:        HINTERNET;
  Context:      DWORD_PTR;
  Status:       DWORD;
  pInformation: Pointer;
  InfoLength:   DWORD ); stdcall;
var
  s: string;
begin
  case Status of
    INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
    INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ' + SockAddrToString(PSOCKADDR(pInformation), InfoLength);
    INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address: ' + SockAddrToString(PSOCKADDR(pInformation), InfoLength);
    INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
    INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
    INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
    INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
    INTERNET_STATUS_INTERMEDIATE_RESPONSE: s := 'Received an intermediate (100 level) status code message from the server';
    INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PAnsiChar(pInformation);
    INTERNET_STATUS_PREFETCH: s := 'Not implemented';
    INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request';
    INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
      PAnsiChar(pInformation);
    INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
    INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' + IntToStr(PDWORD(pInformation)^) + ' Bytes';
    INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PAnsiChar(pInformation);
    INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server';
    INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server';
    INTERNET_STATUS_STATE_CHANGE:
      begin
        s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
        case PDWORD(pInformation)^ of
          INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
          INTERNET_STATE_DISCONNECTED: s := s + #13#10 + 'Disconnected state. No network connection could be established.';
          INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
          INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
          INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
        end;
      end;
  end;
  tss.Add(s);
end;

procedure WinInetCheck(Success: Boolean; Function: PChar);
var
  ErrorCode : Integer;
begin
  if not Success then
  begin
    ErrorCode := GetLastError;
    raise Exception.CreateFmt('%s Error %d: %s', [Function, ErrorCode, GetWinInetError(ErrorCode)]);
  end;
end;

function Https_Post(var callSettings: httpCallSettings; xServer, xRes: string): Integer;
const
  BufferSize = 1024*64;
  AcceptTypes: array[0..] of PChar = ('text/html', 'application/xhtml+xml', 'application/xml;q=0.9', '*/*;q=0.8', nil);
var
  hInet    : HINTERNET;
  hConnect : HINTERNET;
  hRequest : HINTERNET;
  dwBufferLength: DWORD;
  dwReserved    : DWORD;
  dwBytesRead     : DWORD;
  dwNumberOfBytesAvailable: DWORD;
  Header: TStringStream;
  sHeader: String;
begin
  Result := 0;
  tss := TStringList.Create;
  try
    callSettings.Response := '';
    hInet := InternetOpen(PChar(callSettings.uAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    WinInetCheck(hInet <> nil, 'InternetOpen');
    try
      hConnect := InternetConnect(hInet, PChar(xServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
      WinInetCheck(hConnect <> nil, 'InternetConnect');
      try
        hRequest := HttpOpenRequest(hConnect, 'POST', PChar(xRes), HTTP_VERSION, '', @AcceptTypes, INTERNET_FLAG_SECURE or INTERNET_FLAG_KEEP_CONNECTION, 1);
        WinInetCheck(hRequest <> nil, 'HttpOpenRequest');
        try    
          Header := TStringStream.Create('');
          try
            Header.WriteString('Accept-Language: en-us,en;q=0.5' + #13#10);
            Header.WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7' + #13#10);
            Header.WriteString('Keep-Alive: 300' + #13#10);
            if callSettings.ExtraHeader <> '' then
              Header.WriteString(callSettings.ExtraHeader + #13#10);
            if callSettings.CType <> '' then
              Header.WriteString('Content-Type: ' + callSettings.cType + #13#10);
            sHeader := Header.DataString;
            WinInetCheck(HttpAddRequestHeaders(hRequest, PChar(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD), 'HttpAddRequestHeaders');
          finally
            Header.Free;
          end;

          InternetSetStatusCallback(hRequest, @StatusCallback);

          //send the post request
          WinInetCheck(HTTPSendRequest(hRequest, nil, 0, @callSettings.postvars[1], Length(callSettings.postvars)), 'HttpSendRequest');

          //get the response code
          dwBufferLength := SizeOf(Result);
          dwReserved := 0;
          WinInetCheck(HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, dwBufferLength, dwReserved), 'HttpQueryInfo');    
          CallSettings.CallStatus := Result;

          //if the response code =200 then get the body
          if Result = 200 then
          begin
            WinInetCheck(InternetQueryDataAvailable(hRequest, dwNumberOfBytesAvailable, 0, 0), 'InternetQueryDataAvailable');
            SetLength(callSettings.response, dwNumberOfBytesAvailable);
            if dwNumberOfBytesAvailable <> 0 then
              WinInetCheck(InternetReadFile(hRequest, @callSettings.response[1], dwNumberOfBytesAvailable, dwBytesRead), 'InternetReadFile');
          end;
        finally
          InternetCloseHandle(hRequest);
        end;
      finally
        InternetCloseHandle(hConnect);
      end;
    finally
      InternetCloseHandle(hInet);
    end;
    ShowMessage(tss.Text);
  finally
    tss.Free;
  end;
end;