使用TWebBrowser将Html文件批量转换成纯文本文件

       在网上找将Html文件批量转换成纯文本文件的小软件，竟然没有找到合适的。原来做过将单个html转换成txt的，感觉很简单，就是用WebBrowser的body.outerText就行了。

       但真要实现批量转换却发现没有那么简单了。因为WebBrowser打开一个Html是在另外一个线程，并且需要一定的时间，用循环，前一次的html文件还没有打开进行转换，又开始下一次的html文件打开了。因此就需要等WebBrowser打开一个Html，完成转换后再打开下一个。这样想倒是简单，但是实现起来却费些周折。

      开始用

                 Repeat
                    Application.ProcessMessages;
                  Until ();

     无论Until里面怎么设置条件，还是前一次的还没有转换，又开始下一次的html文件打开，转换出来的却是空白文本文件。

     后来看到说在WebBrowser的DocumentComplete事件中处理，于是把转换代码放入里面，却还是不行，这是最后一个实现了转换，其他的还是空白。

     最后在设一个标记，在WebBrowser的DocumentComplete事件被标记社为真值，在转换按钮事件里进行循环转换文，打开文件时等待标记变true，转换完改变标记为false，终于完美实现了将Html文件批量转换成纯文本文件。

      文件的目录打开用了BrowseForFolderU函数，这段代码转载的很多，我从http://hi.baidu.com/zhksoft/blog/item/e6a6d1515fa1bb2342a75b2d.html找到的，感谢原作者，虽然我不知道原作者是谁。

 

代码：http://netscaner.download.youkuaiyun.com/user/netscaner/TWebBrowser

 

unit html2txt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, OleCtrls, SHDocVw, MSHtml, BrowseForFolderU;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Edit2: TEdit;
    Button2: TButton;
    Button3: TButton;
    Edit3: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Edit4: TEdit;
    Memo1: TMemo;
    WebBrowser1: TWebBrowser;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
    URL: OleVariant;
  STem,SaveName:string;
  Webpg:IHTMLDocument2;
  BDone:boolean;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  opath,dpath,omsg:String;
begin
  dpath:='c:/';
  omsg:='请选择路径：';
  opath:=BrowseForFolder(omsg,dpath);
  if opath<>'' then Edit1.Text:=opath
  else
    Application.MessageBox('没有选择路径','系统提示',MB_OK+MB_ICONERROR);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  opath,dpath,omsg:String;
begin
  dpath:='c:/';
  omsg:='请选择路径：';
  opath:=BrowseForFolder(omsg,dpath);
  if opath<>'' then Edit2.Text:=opath
  else
    Application.MessageBox('没有选择路径','系统提示',MB_OK+MB_ICONERROR);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
i,j,k: Integer;
SearchRec: TSearchRec;

begin
  i:=0;
       FindFirst(Edit1.text+'/*.*',faAnyFile,SearchRec);
       Edit4.text:=(SearchRec.Name);
   Repeat
      i:=FindNext(SearchRec);
          If i = 0 then
       Edit4.text:=(SearchRec.Name);
              if Pos('htm',ExtractFileExt(SearchRec.Name))<>0 then
              begin
                  ListBox1.Items.Add(SearchRec.Name);
              end;
   until i <>0;
          For j:=0 to ListBox1.Items.Count-1 do
          begin
                  URL:=Edit1.text+'/'+ListBox1.Items[j];
                  WebBrowser1.Navigate2(URL);
                  Repeat
                    Application.ProcessMessages;
                  Until (BDone=true);
                  Webpg:=WebBrowser1.document as Ihtmldocument2;
                        STem:=webpg.body.outerText;
                        Memo1.Lines.Clear;
                        Memo1.Lines.Add(Stem);
                        k:=1;
                       While (SaveName='') and (k<Memo1.Lines.Count-1) do
                       begin
                                SaveName:=trim(Memo1.Lines.Strings[k]);
                                k:=k+1;
                       end;
                       //还要处理标题中的非法字符
                       for i:=1 to length(SaveName) do
                       begin
                          if SaveName[i] in ['/','/',':','*','?','<','>','|'] then SaveName[i]:=' ' ;
                       end;

                          SaveName:=Edit2.text+'/'+SaveName+'.txt';
                          Memo1.Lines.SaveToFile(SaveName);
                          SaveName:='';
                          BDone:=false;

          end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin
  URL :='about:blank';
  WebBrowser1.Navigate2(URL);
  BDone:=false;
  SaveName:='';
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);

begin

         BDone:=true;
end;

end.