Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 116. - zdrojový HTML kód z IE

Jan Šindelář - 12.11.2003

Získat zdrojový kód stránky z oken právě běžícího IE není zas tak obtížné, jak by se mohlo na první pohled zdát. Ve všem nám totiž pomohou příslušné knihovny (MSHTML, ActiveX a další).

Naším úkolem bude v první fázi identifikovat, která okna patří Internet Exploreru. Tuto činnost budeme provádět v rámci události OnClick příslušného tlačítka a to opakovaně, abychom podchytili všechny běžící instance prohlížeče. Zjistíme-li, že nalezené "okno" je skutečně oknem prohlížeče, obsahující HTML dokument, můžeme na něj použít naší funkci pro získání zdrojového kódu v podobě textových řetězců.

Takto získaný zdrojový kód poté vypíšeme do komponenty Memo, kterou nezapomeňte spolu se zmiňovaným tlačítkem umístit na formulář. Zdrojové kódy jednotlivých stránek (v případě více otevřených oken IE) jsou odděleny několika prázdnými řádky a před každým zdrojovým kódem je rovněž uvedena adresa stránky.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MSHTML, ActiveX, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetHTMLCode(WB: IWebbrowser2; ACode: TStrings): Boolean;
var
  ps: IPersistStreamInit;
  s: string;
  ss: TStringStream;
  sa: IStream;
begin
  ps := WB.document as IPersistStreamInit;
  s := ``;
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, Bool(True)));
    if Result then ACode.Add(ss.Datastring);
  finally
    ss.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ShellWindow: IShellWindows;
  WB: IWebbrowser2;
  spDisp: IDispatch;
  IDoc1: IHTMLDocument2;
  k: Integer;
begin
  ShellWindow := CoShellWindows.Create;
  for k := 0 to ShellWindow.Count do
  begin
    spDisp := ShellWindow.Item(k);
    if spDisp = nil then Continue;
    spDisp.QueryInterface(iWebBrowser2, WB);
    if WB <> nil then
    begin
      WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
      if iDoc1 <> nil then
      begin
        WB := ShellWindow.Item(k) as IWebbrowser2;
        begin
          Memo1.Lines.Add(`========================================`);
          Memo1.Lines.Add(WB.LocationURL);
          Memo1.Lines.Add(`========================================`);
          GetHTMLCode(WB, Memo1.Lines);
          Memo1.Lines.Add(``);
          Memo1.Lines.Add(``);
        end;
      end;
    end;
  end;
end;

end.

Ještě malé upozornění pro uživatele řady Windows 9x. Jelikož otevřených stránek v oknech Internet Exploreru může být hodně a i samotné jednotlivé stránky mohou být poměrně rozsáhlé, nezapomeňte na limit komponenty Memo na 64 kB dat pro tuto generaci systémů Windows. K chybě (rozuměj k pádu aplikace) sice nedojde, ale příslušný zdrojový kód nebude při překročení zmiňované hranice zobrazen celý. S tím je třeba počítat a zvolit pro výpis zdrojového kódu buď jiný způsob (jinou komponentu) a nebo tento stav v programu nějak ošetřit.