2010-07-28 79 views
2

我正在使用Delphi 2007.我可以成功地使用WebBrowser.Navigate發佈數據到網站,但之後,當該網站返回PDF時,它出現在屏幕上的瀏覽器,我無法弄清楚如何以編程方式獲取PDF。我可以使用Document.Body.InnerHTML看到一些文本和HTML,但不能看到PDF。有人可以演示如何獲取POST後出現的PDF?在使用TWebBrowser發佈到網站後獲取PDF返回

感謝yoU!

+1

是否必須是TWebBrowser?用Synapse或Indy來實現它應該很容易。 – mjn 2012-10-29 12:13:20

回答

0

您可以使用IE4 +選項來使用您自己的協議捕獲所有互聯網流量。您甚至可以掛接協議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. 
+1

用法會很好。 – kobik 2012-02-03 00:33:53

+1

@kobik:註冊組件;在表單/數據模塊上使用組件,填寫屬性/事件並將活動設置爲true。運行應用程序,並瞧。 – 2012-02-03 21:51:38

+0

@Eric:我真的不知道。你可以試試。只要安全允許,應該在32位IE中工作。 – 2013-09-27 15:53:37

1

來獲取文本出在Web瀏覽器中的PDF,我發現使用名爲PushKeys一個開源單元發送鍵將網頁瀏覽器的解決方案以選擇所有文本(控制 + ),將其複製到剪貼板(控制 + ç),然後將其粘貼到使用PasteFromClipBoard一個TMemo或其它控制。經過D2007測試。

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');