unit1.pas

取含Frame的网页源码(Delphi)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,StdCtrls,OleCtrls, SHDocVw, ExtCtrls, RzPanel, RzSplit,activex,mshtml;

type
  TForm1 = class(TForm)
    Button1: TButton;
    WebBrowser1: TWebBrowser;
    Panel1: TPanel;
    Edit1: TEdit;
    Button2: TButton;
    RzSizePanel1: TRzSizePanel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function GetHtmlCode(WebBrowser:TWebBrowser):string;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  spDisp: IDispatch;
  i: integer;
  vi: OleVariant;
  IE1: IWebBrowser2;
  IDoc1: IHTMLDocument2;
  HtmlFrame :  IHTMLFramesCollection2;
  HtmlWin   : IHTMLWindow2;
begin
    if WebBrowser1.Busy then
    begin
      showmessage('正忙！');
      exit;
    end;
    if not assigned(WebBrowser1.Document) then
    begin
      showmessage('没有打开网页！');
      exit;
    end;
    memo1.Clear;
    Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                    '-------------------------------------------------------------------------------------------------------------');
    memo1.Lines.Add('以下是网页源码GethtmlCode');
    Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                    '-------------------------------------------------------------------------------------------------------------');
//    memo1.lines.add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);//这种方法只能取到Body
    memo1.Lines.Add(GethtmlCode(webbrowser1));
    Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                    '-------------------------------------------------------------------------------------------------------------');
    memo1.Lines.Add('以下是网页IHtmlDocument2(WebBrowser1.Document).Body.outerText');
    Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                    '-------------------------------------------------------------------------------------------------------------');
    memo1.lines.add(IHtmlDocument2(WebBrowser1.Document).Body.outerText);
    Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                    '-------------------------------------------------------------------------------------------------------------');
    memo1.Lines.Add('以下是网页Frame的源码');
    Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                    '-------------------------------------------------------------------------------------------------------------');
    spDisp := WebBrowser1.OleObject;
    spDisp.QueryInterface(iWebBrowser2, IE1 );
    if IE1 <> nil then
    begin
      IE1.Document.QueryInterface(IHTMLDocument2,iDoc1);
      if iDoc1 <> nil then
      begin
        HtmlFrame := idoc1.Get_frames;
        for i:=0 to HtmlFrame.length-1 do
        begin
          Application.ProcessMessages;
          vi:=i;
          try//有的Frame没法取出，比如sports.tom.com里的frame宽度高度是1，是个asp，有的src指向已经失效等
            spDisp := HtmlFrame.item(vi);
            if SUCCEEDED(spDisp.QueryInterface(IHTMLWindow2 ,HtmlWin))then
            begin
              Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                              '-------------------------------------------------------------------------------------------------------------');
              Memo1.Lines.Add('FrameName:'+HtmlWin.name);  //写上frame的name
              Memo1.Lines.Add('-------------------------------------------------------------------------------------------------------------'+
                              '-------------------------------------------------------------------------------------------------------------');
              if SUCCEEDED(HtmlWin.document.QueryInterface(IHTMLDocument2 ,IDoc1))then
              begin
                vi:=IDoc1.Get_all.item(0,0);
                Memo1.Lines.Add(vi.innerhtml);  //这里是frame的网页代码啦
              end;
            end;
          except;
            showmessage('第'+inttostr(i)+'个Frame没法取出');
          end;
        end;
      end;
    end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  WebBrowser1.Navigate(edit1.Text);
end;

function GetHtmlCode(WebBrowser:TWebBrowser):string;
var
  IpStream: IPersistStreamInit;//IPersistStreamInit在ActiveX单元
  stream:Tstringstream;
  s:string;
begin
  result:='';
  s:='';
  stream:=tstringstream.Create(s);
  with webbrowser do
  begin
    while ReadyState <> READYSTATE_COMPLETE do
      Forms.Application.ProcessMessages;
    if Assigned(Document) then
    begin
      IpStream := Document as IPersistStreamInit;
      IpStream.save(TStreamAdapter.Create(Stream),TRUE);
      result:=stream.DataString;
    end;
  end;

end;


end.