K210.ORG

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.