Delphi, post with WinInet and track upload progress

Question

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

How can I make a post request and track the progress?

This isn't working (check comments):

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;

Remy Lebeau · Accepted Answer · 2016-04-13T17:23:05.493

Use InternetSetStatusCallback() to register a callback function with the HTTP session to receive status information at various stages of the request operation.

Do note the following warning in the documentation:

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).

Try something more like this:

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;

Can't get it to work, my callback proc is never called, could I get a little example code? I'm calling InternetSetStatusCallback right after InternetConnect with the handle I used on that one. — hikari, Apr 13 '16 at 11:55
@hikari note the documentation: "*A callback function can be set on any handle, and is inherited by derived handles... You must change the callback function at each level.*" That means a callback can be set for the `InternetConnect()` handle that is different than a callback set for the `HttpOpenRequest()` handle. You are setting a callback for the `InternetConnect()` handle, try the `HttpOpenRequest()` handle instead. And make sure the `dwContext` parameter is not being set to 0 when opening the handle. If you still cannot get it to work, please edit your question to show your new code. — Remy Lebeau, Apr 13 '16 at 14:05
Added a little code, it's mostly the same from the other post linked in my question, so just posted the relevant part. — hikari, Apr 13 '16 at 14:32
@hikari the other post is setting `dwContext` to 0, are you still doing the same? — Remy Lebeau, Apr 13 '16 at 14:57
Oh yeah I was. Not sure if I'm still doing everything correctly though; mycallback is triggered now, should I be looking for INTERNET_STATUS_SENDING_REQUEST? None of the parameters in the callback seem to point at the size of the data sent. — hikari, Apr 13 '16 at 16:12
When `dwInternetStatus` is `INTERNET_STATUS_REQUEST_SENT`, "*the lpvStatusInformation parameter points to a DWORD value that contains the number of bytes sent.*" — Remy Lebeau, Apr 13 '16 at 16:22
I saw that, but I'm getting incorrect data. This is a log of all the calls to my callback: http://i.imgur.com/aujCzdl.png I will add the full code to my original question. This log is for a 100KB file sent. — hikari, Apr 13 '16 at 16:35
In your `INTERNET_STATUS_REQUEST_SENT` case, `NativeUInt(pInformation)` is wrong, it needs to be `PDWORD(pInformation)^` instead. Same with `INTERNET_STATUS_STATE_CHANGE`, it should be using `PDWORD(pInformation)^`. And `INTERNET_STATUS_RESPONSE_RECEIVED` does not provide a byte count, but you are trying to access one. — Remy Lebeau, Apr 13 '16 at 16:41
Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/109070/discussion-between-remy-lebeau-and-hikari). — Remy Lebeau, Apr 13 '16 at 16:49

Delphi, post with WinInet and track upload progress

1 Answers1