Главная » Delphi » Интернет и сети » Получить HTML-код из окна IE

Получить HTML-код из окна IE

15:44
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, activex, mshtml, SHDocVw;
 
type
  TObjectFromLResult = function(LRESULT: lResult; const IID: TIID; WPARAM: wParam; out pObject): HRESULT; stdcall;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
function WB_GetHTMLCode(WebBrowser: iwebbrowser2; ACode: TStrings): Boolean;
implementation
 
{$R *.dfm}
 
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
var
  hInst: HWND;
  lRes: Cardinal;
  MSG: Integer;
  pDoc: IHTMLDocument2;
  ObjectFromLresult: TObjectFromLresult;
begin
  hInst := LoadLibrary('Oleacc.dll');
  @ObjectFromLresult := GetProcAddress(hInst, 'ObjectFromLresult');
  if @ObjectFromLresult <> nil then begin
    try
      MSG := RegisterWindowMessage('WM_HTML_GETOBJECT');
      SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
      Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
      if Result = S_OK then
        (pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
    finally
      FreeLibrary(hInst);
    end;
  end;
end;
 
function WB_GetHTMLCode(WebBrowser: iwebbrowser2; ACode: TStrings): Boolean;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  s := '';
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, True));
    if Result then ACode.Add(ss.Datastring);
  finally
    ss.Free;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  Wnd: HWND;
  WndChild: HWND;
  IE: iwebbrowser2;
begin
  Wnd := FindWindow('IEFrame', nil);
  if Wnd = 0 then //No running instance of Internet Explorer so stop!
  begin
    showmessage('No Running instance of Internet Explorer');
    exit;
  end;
// walk Shell DocObject View->Internet Explorer_Server
  WndChild := FindWindowEX(Wnd, 0, 'Shell DocObject View', nil);
  if WndChild <> 0 then begin
    WndChild := FindWindowEX(WndChild, 0, 'Internet Explorer_Server', nil);
    if WndChild <> 0 then
    begin
      GetIEFromHWnd(WndChild, IE); //Get Iwebbrowser2 from Handle
      memo1.Clear;
      WB_GetHTMLCode(IE, memo1.Lines);
    end;
  end;
end;
 
end.