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