Question

How can I get all the request headers with OIBindInfo or IWinInetHttpInfo? I use this in Start but the variable Headers or RequestHeaders is always empty?

Approach using OIBindInfo:

function THandler.Start(szUrl: PWideChar; OIProtSink:
IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved:
DWORD): HResult; stdcall;
var
    dwSize: ULONG;
    pszHeaders: POleStr;
    Headers: String;
begin
    OIBindInfo.GetBindString(BINDSTRING_HEADERS, @pszHeaders, 1, dwsize)
    Headers := PWideChar(pszHeaders); // weird result of Headers = ჸ
    CoTaskMemFree(pszHeaders);
    pszHeaders := nil;
    Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
end;

Approach using IWinInetHttpInfo:

type
  THandler = class(TComObject, IInternetProtocol, IWinInetHttpInfo)
    private
      ServiceProvider: IServiceProvider;
      WinInetHttpInfo: IWinInetHttpInfo;
      URL: String;
      RequestHeaders: String;
      function QueryInfoEx(dwOption: DWORD; var Info: string): Boolean;
    protected
      function Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
        OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
      function Continue(const ProtocolData: TProtocolData): HResult; stdcall;
      function Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
      function Terminate(dwOptions: DWORD): HResult; stdcall;
      function Suspend: HResult; stdcall;
      function Resume: HResult; stdcall;
      function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;
      function Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
        out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
      function LockRequest(dwOptions: DWORD): HResult; stdcall;
      function UnlockRequest: HResult; stdcall;
      function QueryInfo(dwOption: DWORD; Buffer: Pointer; var cbBuf, dwFlags, dwReserved: DWORD): HResult; stdcall;
      function QueryOption(dwOption: DWORD; Buffer: Pointer; var cbBuf: DWORD): HResult; stdcall;
  end;

function THandler.QueryInfoEx(dwOption: DWORD; var Info: string): Boolean;
var
  Buf: array[0..INTERNET_MAX_PATH_LENGTH] of AnsiChar;
  BufLength, dwReserved, dwFlags: Cardinal;
begin
    dwReserved := 0;
    dwFlags := 0;
    BufLength := INTERNET_MAX_PATH_LENGTH + 1;
    Result := not Boolean(WinInetHttpInfo.QueryInfo(dwOption, @Buf, BufLength, dwFlags, dwReserved));
    if Result then 
    Info := string(Buf);
end;

function THandler.Start(szUrl: PWideChar; OIProtSink:
IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved:
DWORD): HResult; stdcall;
begin
  OIProtSink.QueryInterface(IServiceProvider, ServiceProvider);
  OIProtSink.QueryInterface(IWinInetHttpInfo, WinInetHttpInfo);
  QueryInfoEx(HTTP_QUERY_RAW_HEADERS, RequestHeaders); // empty RequestHeaders
  Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
end;

Neither are working!

Was it helpful?

Solution

You are not looking at the return value of GetBindString() to make sure it outputs any data.

Using a single POleStr is fine if you are retrieving a specific header, eg:

function THandler.Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
var
  MimeType: POleStr;
  Fetched: ULONG;
begin
  if Succeeded(OIBindInfo.GetBindString(BINDSTRING_POST_DATA_MIME, @MimeType, 1, Fetched)) then
  begin
    // use MimeType as needed...
    CoTaskMemFree(MimeType);
  end;
  Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
end;

However, you are trying to retrieve multiple headers, so you need to use an array instead:

function THandler.Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
var
  Headers: array[0..255] of POleStr;
  Fetched, I: ULONG;
begin
  Fetched := 0;
  if Succeeded(OIBindInfo.GetBindString(BINDSTRING_HEADERS, @Headers[0], Length(Headers), Fetched)) then
  begin
    if Fetched > 0 then
    begin
      for I := 0 to Fetched-1 do
      begin
        // use Headers[I] as needed...
        CoTaskMemFree(Headers[I]);
      end;
    end;
  end;
  Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
end;

That being said, MSDN says that BINDSTRING_HEADERS is "Not currently supported".

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top