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会话注册回调函数，以在请求操作的各个阶段接收状态信息。

请在文档中注意以下警告：

注意当 dwContext 参数{时， lpfnInternetCallback 参数中指定的回调函数将不会在请求句柄的异步操作上调用{1}}设置为零（HttpOpenRequest），或INTERNET_NO_CALLBACK的 dwContext 句柄设置为零（InternetConnect）时的连接句柄。 / p>

尝试更像这样的事情：

INTERNET_NO_CALLBACK

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

1 个答案: