使用 TWebBrowser 获取发布到网站后返回的 PDF

Question

我使用的是 Delphi 2007。我可以使用 WebBrowser.Navigate 成功地将数据发布到网站，但是之后，当该网站返回 PDF 时，当它出现在浏览器的屏幕上时，我不知道如何获取以编程方式生成 PDF。我可以使用 Document.Body.InnerHTML 看到一些文本和 HTML，但看不到 PDF。有人可以演示如何获取 POST 之后出现的 PDF 吗？

谢谢你！

Answer 1

为了在网络浏览器中从 PDF 中获取文本，我找到了一个解决方案，使用名为 PushKeys 的开源单元将密钥发送到网络浏览器以选择所有文本（Control +A），将其复制到剪贴板（Control+C），然后将其粘贴到TMemo 或使用@987654323 的其他控件@。在 2007 年测试。

WebBrowser.SetFocus;  // set the focus to the TWebBrowser control
Sleep(1000);  // 1 second delay to be sure webbrowser actually has focus
Application.ProcessMessages;
PushKeys('^a'); //send ctrl-a to select all text
Application.ProcessMessages;
WebBrowser.SetFocus;
PushKeys('^c'); //send ctrl-c to copy the text to clipboard
Sleep(1000);  // 1 second delay to make sure clipboard finishes processing
Application.ProcessMessages;
Memo1.PasteFromClipBoard; // Paste the clipboard to a memo field. 
                          // You could also use the clipbrd unit to handle the data.
//for Multi-page PDF's, you can send a PageDn key to get to the next page:
PushFnKey('PAGEDOWN');

Answer 2

您可以使用 IE4+ 选项来使用您自己的协议捕获所有 Internet 流量。您甚至可以挂钩协议 http (IIRC)，当您需要加载数据时，可以使用 WIndows 函数和/或 Indy 组件。

这是一个这样做的单位：

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