如何將WebBrowser中的內容將Html語法

引言: 如何將WebBrowser中的內容將Html語法< tr >< /tr >...等資料移除, 只留下Text內容存入Memo中?請各位前輩指導,謝謝. < face="Verdana, Arial, Helvetica">

uses MSHTML;    ..    procedure TForm1.Button2Click(Sender: TObject);
var
  hd: IHTMLDocument2;
begin
  hd := WebBrowser1.Document as IHTMLDocument2;
  Memo1.Lines.Text := hd.body.innerText;
end;

首先先謝謝timhuang提供該方法,但尚有一問題,如果該網頁(網站)是用 多頁網頁(框架)就innerText無法作用,請問有解決方法嗎?

若是只有一層的 frame 語法可以這樣下:    

procedure TForm1.Button3Click(Sender: TObject);
var
  hd: IHTMLDocument2;
  i: integer;
  ind: OleVariant;
  o: OleVariant;
begin
  hd := WebBrowser1.Document as IHTMLDocument2;
  if hd.frames.length > 0 then
    for i:=0 to hd.frames.length-1 do
    begin
      ind := i;
      o := hd.frames.item(ind);
      Memo1.Lines.Add('frame[' IntToStr(i) ']');
      Memo1.Lines.Add(o.Document.body.innerTEXT );
    end
  else
    Memo1.Lines.Text := hd.body;
end;

若是 frame 中還有 frame 的話, 可以稍微改寫一下, 修改為 recursive 的作法就可以了. 由於在 frames.item(x) 的傳入值及傳回值都是 OleVariant, 所以操作上要比較注意一些. 若是修改為 resursive 的作法有困難的話, 請再提出!

謝謝 timhuang兄 指導,我試試再回報測試結果,謝謝.

hi!chfamy 對不起!我想插一下花我想請教timhuang兄!我要啟動WebBrowser1及擷取Txt二個動作一次完成如下,到最後及出錯!可有辦法解決嗎? procedure TForm1.Button1Click(Sender: TObject); var hd: IHTMLDocument2; //uses MSHTML; Flags: OLEVariant; begin Flags := 0; WebBrowser1.Navigate(WideString('http://tw.yahoo.com'), Flags, Flags, Flags, Flags); sleep(2000); hd := WebBrowser1.Document as IHTMLDocument2; Application.ProcessMessages; memo1.Text := hd.body.innerText; end; 何明昌

------
何明昌

Hi:    Sorry，我也插花一下 mcho，我以領航天使大大發表的文章， 修改了一下程式碼如下，供你參考    

unit Unit1;    interface    uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, ExtCtrls, ComCtrls, ShDocVw, MSHTML, DB, DBTables;    type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    Query1: TQuery;
    StatusBar1: TStatusBar;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  QueryTest = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;    var
  Form1: TForm1;
  OkString : string;    implementation    {$R *.DFM}    // Thread執行程式
procedure QueryTest.Execute;
var
    Flags: OLEVariant;
begin
    try
        Flags := 0;
        Form1.WebBrowser1.Navigate(WideString('http://tw.yahoo.com'), Flags, Flags, Flags, Flags);
    except
    end;
end;
// 執行按鈕
procedure TForm1.Button1Click(Sender: TObject);
var Q : QueryTest;
    Time1 : TDateTime;
    F : Double;
    hd: IHTMLDocument2; //uses MSHTML;    begin
    Time1 := Now;
    Q := QueryTest.Create(False);
    while OKString = '' do // 還未執行完成時
        begin
            F := Now()-Time1;
            F := F * (24 * 60 * 60.0);
            Label1.Caption := Format('所花時間:%.2f秒',[F]);
            Application.ProcessMessages;
        end;
    HD := WebBrowser1.Document as IHTMLDocument2;
    Application.ProcessMessages;
    Memo1.Clear;
    Memo1.Text := HD.body.innerText;
end;    // 一個在Thread Query仍然可以執行的測試Timer
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels[0].text := DateTimeToStr(Now);
end;    procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
    OKString := 'OK'
end;    end.

-------------------------------- 小弟才疏學淺，若有謬誤請不吝指教 --------------------------------

------
Fishman

Hi:    對不起各位，剛剛思考了一下，用 Thread 好像有點多此一舉 只要定一個全域變數 OKString，在執行 WebBrowser1.Navigate(WideString('http://tw.yahoo.com'), Flags, Flags, Flags, Flags) 前先行清空，並於 WebBrowser1 的 OnDocumentComplete 事件將值存入，而 Button 的 OnClick 事件，設一個迴圈直到 OKString 有值寫入，再行執行寫入 Memo1 的程式碼即可

unit Unit1;    interface    uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, ExtCtrls, ComCtrls, ShDocVw, MSHTML, DB, DBTables;    type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  QueryTest = class(TThread)
  private
    { Private declarations }
  protected      end;    var
  Form1: TForm1;
  OkString : string;    implementation    {$R *.DFM}    // 執行按鈕
procedure TForm1.Button1Click(Sender: TObject);
var Q : QueryTest;
    Time1 : TDateTime;
    F : Double;
    Flags: OLEVariant;
    hd: IHTMLDocument2; //uses MSHTML;
begin
    Time1 := Now;
    OKString := '';
    Flags := 0;
    WebBrowser1.Navigate(WideString('http://tw.yahoo.com'), Flags, Flags, Flags, Flags);
    while OKString = '' do // 還未執行完成時
        begin
            F := Now()-Time1;
            F := F * (24 * 60 * 60.0);
            Label1.Caption := Format('所花時間:%.2f秒',[F]);
            Application.ProcessMessages;
        end;
    HD := WebBrowser1.Document as IHTMLDocument2;
    Application.ProcessMessages;
    Memo1.Clear;
    Memo1.Text := HD.body.innerText;
end;    procedure TForm1.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels[0].text := DateTimeToStr(Now);
end;    procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
    OKString := 'OK'
end;    end.

-------------------------------- 小弟才疏學淺，若有謬誤請不吝指教 --------------------------------

------
Fishman

謝謝 Fishman 您很熱心且很厲害,真的可以執行,同時也要謝謝 chfamy 的問題很好! 何明昌

------
何明昌

謝謝大家熱心的協助,特別是Fishman的熱心,我用Fishman程式碼解決了我的 問題,真的十萬分謝謝大家,因為只能有一個給分,所以給Fishman,謝謝大家!

下列URL經由WebBrowser->innerText轉成Text會發生"資料存取錯誤", 不知原因為何?請問是否有解,謝謝. PChome Online 網路家庭-家族-貼圖 http://club.pchome.com.tw/photo/myimg_list.php?club_e_name=sannyche&book_id=5

Hi:    抱歉，>< face="Verdana, Arial, Helvetica">引言: uses MSHTML; .. procedure TForm1.Button2Click(Sender: TObject); var hd: IHTMLDocument2; begin hd := WebBrowser1.Document as IHTMLDocument2; Memo1.Lines.Text := hd.body.innerText; end; 我也不知有以上方法可用，藉由回答網友問題，同時也可以一邊學習，不僅可以幫助自己也可以幫助別人，KTop 真是一個好地方 chfamy，我試了一下 http://club.pchome.com.tw/photo/myimg_list.php?club_e_name=sannyche&book_id=5 程式執行正常，未有錯誤訊息 -------------------------------- 小弟才疏學淺，若有謬誤請不吝指教 --------------------------------

可以請問一下 timhuang 兄所提及的多層Frame 網頁內容的抓法嗎?? 謝謝