Acquire PDF returned after Posting to a web site using TWebBrowser

Question

I am using Delphi 2007. I can successfully Post data to a web site using WebBrowser.Navigate, but afterwards, when that site returns a PDF, while it appears on the screen of the Browser, I cannot figure out how to acquire the PDF programmatically. I can see some text and HTML using Document.Body.InnerHTML, but not the PDF. Can someone demonstrate how to acquire the PDF which appears after the POST?

Thank yoU!

Answer 1

You could use an IE4+ option for capturing all internet traffic using your own protocol. You can even hook the protocol http (IIRC) and when you need to load the data use the WIndows functions and/or Indy components.

This is a unit to do so:

{
  This component allows you to dynamically create your own internet protocols for
  Microsoft Internet Explorer 4+. Simply place the component on your form, set the protocol
  property to something useful and set the Active property.

  For example, when the Protocol is set to 'private', you can trap requests to
  'private:anythingyoulike'.
}
unit UnitInternetProtocol;

// Developed by: R.A. Hornstra
// (C) 2001 ContinuIT BV

interface

uses
  SysUtils, Windows, Classes, Messages;

type
  TInternetProtocol = class;

  {
    When a request is made, the data must be returned in a TStream descendant.
    The request is present in Request. The result should be saved in Stream.
    When no data can be linked to the request, leave Stream equal to nil.
    See @link(TInternetProtocol.OnRequestStream) and @link(TInternetProtocol.OnReleaseStream).
  }
  TProtocolRequest = procedure(Sender: TInternetProtocol; const Request: string;
                               var Stream: TStream) of object;

  {
    When a request is done by the Microsoft Internet Explorer it is done via an URL.
    This URL starts with a protocol, than a colon and than a protocol specific resource identifier.
    New protocols can be added dynamically and privately for each session.
    This component will register / deregister new protocols to the Microsoft Internet Explorer.
    You should set the name of the protocol with @link(Protocol), activate / deactivate the
    protocol with @link(Active). The implementation of the protocol can be done with the
    events @link(OnRequestStream) and @link(OnReleaseStream).
  }
  TInternetProtocol = class(TComponent)
  private
    FHandle: HWnd;
    FActive: Boolean;
    FProtocol: string;
    FRequest: TProtocolRequest;
    FRelease: TProtocolRequest;
    procedure SetActive(const Value: Boolean);
    procedure SetProtocol(const Value: string);
  protected
    procedure Loaded; override;
    procedure Activate;
    procedure Deactivate;
    procedure WndProc(var Message: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    {
      Setting this property will activate or deactivate the internet
    }
    property Active: Boolean read FActive write SetActive;
    {
      The protocol name must be specified. default, this is 'private'.
      You should fill it here without the trailing colon (that's part of the URL notation).
      Protocol names should be valid identifiers.
    }
    property Protocol: string read FProtocol write SetProtocol;
    {
      When a request is made on the selected protocol, this event is fired.
      It should return a TStream, based upon the given Request.

      The default behaviour of TInternetProtocol is freeing the stream.
      To override or monitor this behaviour, use @link(OnRequestStream).
    }
    property OnRequestStream: TProtocolRequest read FRequest write FRequest;
    {
      When a stream is about to be released by TInternetProtocol, you can override the
      default behaviour. By Setting the Stream variable to nil in the OnReleaseStream handler,
      the stream will not be released by TInternetProtocol.
      This is handy when you're implementing a caching system, or for some reason need control on
      the creation and deletion to the streams.
      The default behaviour of TInternetProtocol is freeing the stream.
    }
    property OnReleaseStream: TProtocolRequest read FRelease write FRelease;
  end;

  {
    All exceptions raised by @link(TInternetProtocol) are of type EInternetException.
  }
  EInternetException = class(Exception);

procedure Register;

implementation

uses
  ComObj, ActiveX, UrlMon, Forms;

resourcestring
  strNotAValidProtocol = 'The Internet Protocol selected is not a valid protocol identifier';

// todo: move registration to separate file
procedure Register;
begin
  Classes.RegisterComponents('Internet',[TInternetProtocol]);
end;

// forward declarations
procedure RegisterProtocol(Protocol: string; Handler: TInternetProtocol); forward;
procedure UnregisterProtocol(Protocol: string); forward;

const
  IID_TInternetProtocolHandler: TGUID = '{B74826E0-1107-11D5-B166-0010D7090486}';
  WM_STREAMNEEDED = WM_USER;

{ TInternetProtocol }

constructor TInternetProtocol.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActive := False;
  FProtocol := 'private';
  FRequest := nil;
  FRelease := nil;
  FHandle := Forms.AllocateHWnd(WndProc);
end;

destructor TInternetProtocol.Destroy;
begin
  Active := False;
  Forms.DeallocateHWnd(FHandle);
  inherited Destroy;
end;

procedure TInternetProtocol.Loaded;
begin
  inherited Loaded;
  if FActive then Activate;
end;

procedure TInternetProtocol.SetActive(const Value: Boolean);
begin
  if Value = FActive then Exit;
  if Value then begin
    if not (csLoading in ComponentState) then Activate;
  end else begin
    Deactivate;
  end;
  FActive := Value;
end;

procedure TInternetProtocol.Activate;
begin
  if csDesigning in ComponentState then Exit;
  RegisterProtocol(FProtocol,Self);
end;

procedure TInternetProtocol.Deactivate;
begin
  if csDesigning in ComponentState then Exit;
  UnregisterProtocol(FProtocol);
end;

procedure TInternetProtocol.SetProtocol(const Value: string);
var AActive: Boolean;
begin
  if not SysUtils.IsValidIdent(Value) then raise EInternetException.Create(strNotAValidProtocol);
  AActive := FActive;
  try
    Active := False;
    FProtocol := Value;
  finally
    Active := AActive;
  end;
end;

procedure TInternetProtocol.WndProc(var Message: TMessage);
var
  Msg: packed record
    Msg: Longword;
    Request: PChar;
    Stream: ^TStream;
  end;
begin
  if Message.Msg = WM_STREAMNEEDED then begin
    System.Move(Message,Msg,SizeOf(Msg));
    if Assigned(FRequest) then FRequest(Self,string(Msg.Request),Msg.Stream^);
  end else Message.Result := Windows.DefWindowProc(FHandle,Message.Msg,Message.WParam,Message.LParam);
end;

var
  Session: IInternetSession;     // The current Internet Session
  Factory: IClassFactory;        // Factory of our IInternetProtocol implementation
  Lock: TRTLCriticalSection;     // The lock for thread safety
  List: TStrings;                // The list of active protocol handlers

type
  TInternetProtocolHandler = class(TInterfacedObject, IInternetProtocol)
  private
    ProtSink: IInternetProtocolSink; // Protocol Sink that needs the data
    Stream: TStream;                 // Stream containing the data
    StreamPosition: Integer;         // Current Position in the stream
    StreamSize: Integer;             // Current size of the stream
    LockCount: Integer;              // Lock count for releasing data
    procedure ReleaseStream;
  public
    { IInternetProtocol }
    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;
  end;

  TInternetProtocolHandlerFactory = class(TInterfacedObject, IClassFactory)
  public
    { IClassFactory }
    function CreateInstance(const unkOuter: IUnknown; const iid: TIID; out obj): HResult; stdcall;
    function LockServer(fLock: BOOL): HResult; stdcall;
  end;

procedure RegisterProtocol(Protocol: string; Handler: TInternetProtocol);
var
  i: Integer;
  Proto: WideString;
begin
  Windows.EnterCriticalSection(Lock);
  try
    // if we have a previous handler, delete that from the list.
    i := List.IndexOf(Protocol);
    if i >=0 then TInternetProtocol(List.Objects[i]).Active := False;
    // If this is the first time, create the Factory and get the Internet Session object
    if List.Count = 0 then begin
      Factory := TInternetProtocolHandlerFactory.Create;
      CoInternetGetSession(0, Session, 0);
    end;
    // Append ourselves to the list
    List.AddObject(Protocol,Handler);
    // Register the protocol with the Internet session
    Proto := Protocol;
    Session.RegisterNameSpace(Factory, IInternetProtocol{  IID_TInternetProtocolHandler}, PWideChar(Proto), 0, nil, 0);
  finally
    Windows.LeaveCriticalSection(Lock);
  end;
end;

procedure UnregisterProtocol(Protocol: string);
var i: Integer;
    Proto: WideString;
begin
  Windows.EnterCriticalSection(Lock);
  try
    i := List.IndexOf(Protocol);
    if i < 0 then Exit; // oops, protocol was somehow already freed... this should not happen
    // unregister our namespace handler
    Proto := Protocol; // to widestring
    Session.UnregisterNameSpace(Factory, PWideChar(Proto));
    // and free from list
    List.Delete(i);
    // see if we need to cleanup?
    if List.Count = 0 then begin
      // release the COM server
      Session := nil;
      Factory := nil;
    end;
  finally
    Windows.LeaveCriticalSection(Lock);
  end;
end;

{ TInternetProtocolHandler }

function TInternetProtocolHandler.Abort(hrReason: HResult; dwOptions: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TInternetProtocolHandler.Continue(const ProtocolData: TProtocolData): HResult;
begin
  Result := S_OK;
end;

function TInternetProtocolHandler.LockRequest(dwOptions: DWORD): HResult;
begin
  Inc(LockCount);
  Result := S_OK;
end;

function TInternetProtocolHandler.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
const Results: array [Boolean] of Longword = ( E_PENDING, S_FALSE );
begin
  if Assigned(Stream) then cbRead := Stream.Read(pv^,cb) else cbRead := 0;
  Inc(StreamPosition, cbread);
  Result := Results[StreamPosition = StreamSize];
end;

procedure TInternetProtocolHandler.ReleaseStream;
begin
  // see if we can release the Stream...
  if Assigned(Stream) then FreeAndNil(Stream);
  Protsink := nil;
end;

function TInternetProtocolHandler.Resume: HResult;
begin
  Result := E_NOTIMPL;
end;

function TInternetProtocolHandler.Seek(dlibMove: LARGE_INTEGER;
  dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult;
begin
  Result := E_NOTIMPL;
end;

function TInternetProtocolHandler.Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
  OIBindInfo: IInternetBindInfo; grfPI,dwReserved: DWORD): HResult;
var URL, Proto: string;
    i: Integer;
    Handler: TInternetProtocol;
begin
  // Sanity check.
  Assert(Assigned(OIProtSink));
  Assert(Assigned(szUrl));
  Assert(Assigned(OIBindInfo));

  URL := szUrl;
  Stream := nil; // just to make sure...

  // Clip the protocol name from the URL & change the URL to the proto specific part
  i := Pos(':',URL);
  if i > 0 then begin
    Proto := Copy(URL,1,i-1);
    URL := Copy(URL,i+1,MaxInt);
  end;

  Windows.EnterCriticalSection(Lock);
  try
    i := List.IndexOf(Proto);
    if i >= 0 then begin
      // we've found our protocol
      Handler := TInternetProtocol(List.Objects[i]);
      // And query. Use a Windows message for thread synchronization
      Windows.SendMessage(Handler.FHandle,WM_STREAMNEEDED,WParam(PChar(URL)),LParam(@Stream));
    end;
  finally
    Windows.LeaveCriticalSection(Lock);
  end;

  if not Assigned(Stream) then begin
    Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
    Exit;
  end;
  // Setup all data
  StreamSize := Stream.Size;
  Stream.Position := 0;
  StreamPosition := 0;
  LockCount := 1;

  // Get the protocol sink & start the 'downloading' process
  ProtSink := OIProtSink;
  ProtSink.ReportData(BSCF_FIRSTDATANOTIFICATION or BSCF_LASTDATANOTIFICATION or
                      BSCF_DATAFULLYAVAILABLE, StreamSize, StreamSize);
  ProtSink.ReportResult(S_OK, S_OK, nil);
  Result := S_OK;
end;

function TInternetProtocolHandler.Suspend: HResult;
begin
  Result := E_NOTIMPL;
end;

function TInternetProtocolHandler.Terminate(dwOptions: DWORD): HResult;
begin
  Dec(LockCount);
  if LockCount = 0 then ReleaseStream;
  Result := S_OK;
end;

function TInternetProtocolHandler.UnlockRequest: HResult;
begin
  Dec(LockCount);
  if LockCount = 0 then ReleaseStream;
  Result := S_OK;
end;

{ TInternetProtocolHandlerFactory }

function TInternetProtocolHandlerFactory.CreateInstance(const unkOuter: IInterface;
  const iid: TIID; out obj): HResult;
begin
  if IsEqualGUID(iid, IInternetProtocol) then begin
    IInternetProtocol(obj) := TInternetProtocolHandler.Create as IInternetProtocol;
    Result := S_OK;
  end else if IsEqualGUID(iid, IInterface) then begin
    IInterface(obj) := TInternetProtocolHandler.Create as IInterface;
    Result := S_OK;
  end else begin
    Result := E_NOINTERFACE; 
  end;
end;

function TInternetProtocolHandlerFactory.LockServer(fLock: BOOL): HResult;
begin
  if fLock then _AddRef else _Release;
  Result := S_OK;
end;

initialization
begin
  // Get a critical section for thread synchro
  Windows.InitializeCriticalSection(Lock);
  // The list of protocol handlers
  List := TStringList.Create;
end;

finalization
begin
  // deactivate all handlers (should only happen when memory leaks are present...)
  while List.Count > 0 do TInternetProtocol(List.Objects[0]).Active := False;
  List.Free;
  // and delete the critical section
  Windows.DeleteCriticalSection(Lock);
end;

end.