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

最新推荐文章于 2025-03-13 12:17:08 发布

原创最新推荐文章于 2025-03-13 12:17:08 发布 · 1.5k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#html #webbrowser #button #url #forms #windows

本文介绍了一种使用Delphi和WebBrowser控件批量将HTML文件转换为纯文本的方法。通过监听DocumentComplete事件并采用标记来确保每个HTML文件完全加载后再进行转换，最终成功实现了批量转换的需求。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

在网上找将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;

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.