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

本文介绍了一种使用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;

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.

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值