2010-07-28 35 views
2

J'utilise Delphi 2007. Je peux publier des données avec succès sur un site Web en utilisant WebBrowser.Navigate, mais par la suite, lorsque ce site renvoie un PDF, alors qu'il apparaît à l'écran du navigateur, je n'arrive pas à comprendre comment acquérir le PDF par programmation. Je peux voir du texte et du HTML en utilisant Document.Body.InnerHTML, mais pas le PDF. Quelqu'un peut-il démontrer comment acquérir le PDF qui apparaît après le POST?Acquérir PDF retourné après Publication sur un site Web utilisant TWebBrowser

Merci yoU!

+1

Est-ce que ce doit être TWebBrowser? Il devrait être facile d'implémenter ceci avec Synapse ou Indy. – mjn

Répondre

0

Vous pouvez utiliser une option IE4 + pour capturer tout le trafic Internet en utilisant votre propre protocole. Vous pouvez même accrocher le protocole http (IIRC) et lorsque vous devez charger les données, utilisez les fonctions WIndows et/ou les composants Indy.

C'est une unité de le faire:

{ 
    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

l'utilisation sera agréable. – kobik

+1

@kobik: enregistrer le composant; utilisez le composant sur votre formulaire/datamodule, remplissez les propriétés/event et définissez active sur true. Exécutez l'application et le tour est joué. –

+0

@Eric: Honnêtement, je ne le saurais pas. Tu pourrais essayer. Devrait fonctionner en IE 32 bits tant que la sécurité le permet. –

1

Pour obtenir le texte d'un PDF dans le navigateur web, j'ai trouvé une solution à l'aide d'une unité open source appelée PushKeys d'envoyer des clés au navigateur Web pour sélectionner tout le texte (contrôle + a), le copier dans le presse-papiers (contrôle + C), puis le coller à un TMemo ou un autre contrôle en utilisant PasteFromClipBoard. Testé en 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');