// 说明:打开对话框后直接保存对应的txt文件,滤除html代码非常有用,但对多个文件时发生错误,若需要修改后Email一份给您.
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
clipbrd, StdCtrls, ComCtrls, OleCtrls, SHDocVw, ExtCtrls,FileCtrl;
type
THTMToTxt_Frm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
Panel3: TPanel;
WebBrowser1: TWebBrowser;
Splitter2: TSplitter;
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
Panel4: TPanel;
ProgressBar1: TProgressBar;
Button4: TButton;
procedure MakeTree;
Procedure HtmProcess(TempFname:string);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;
var
HTMToTxt_Frm: THTMToTxt_Frm;
Fname:string;
GFname:string;
implementation
{$R *.DFM}
//----------maketree ---------
procedure THTMToTxt_Frm.MakeTree;
var Sr : TSearchRec;
Err : integer;
//SFname:string;
//LenFname:integer;
Begin
Err:=FindFirst('*.htm',$37,Sr) ;
While (Err = 0) do
begin
if Sr.Name[1]<>'.' then
begin
if (Sr.Attr and faDirectory)=0 then
begin
GFName:='';
GFName:=ExpandFileName(sr.Name);
HtmProcess(GFName);
{ SFname:=GFname;
LenFname:=Length(GFname);
Delete(SFname,LenFname-2,3);
SFname:=SFname+'txt';
WebBrowser1.Navigate(GFname);
Memo1.Clear;
ClipBoard.Clear;
WebBrowser1.ExecWB(17,2);
WebBrowser1.ExecWB(12,2);
Memo1.PasteFromClipboard;
Memo1.Lines.SaveToFile(SFname);
}
end;
end;
{ Begin Recursion }
If ((Sr.Attr and faDirectory)<>0)AND(Sr.Name[1] <> '.') then
begin
ChDir(Sr.Name) ;
MakeTree ;
ChDir('..') ;
end ;
Err:=FindNext(Sr) ;
end ;
End;
//--end maketree -------------
//---start htm proess
procedure THTMToTxt_Frm.HtmProcess(TempFname:string);
var
CurrentFile:string;
begin
CurrentFile:=TempFname;
WebBrowser1.Navigate(CurrentFile);
end;
//---end htm proess
procedure THTMToTxt_Frm.Button1Click(Sender: TObject);
var
HtmlDir:String;
begin
GetDir(0,HtmlDir);
OpenDialog1.InitialDir:=HtmlDir+'/html';
OpenDialog1.Execute;
Fname:=Opendialog1.FileName;
WebBrowser1.Navigate(Fname);
Edit1.text:=Fname;
end;
procedure THTMToTxt_Frm.Button4Click(Sender: TObject);
var
GDir:string;
begin
SelectDirectory('请选择需要转换为TXT文件的目录','',GDir);
ChDir(GDir);
MakeTree;
end;
procedure THTMToTxt_Frm.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
SFName:string;
LenFname:integer;
begin
SFname:=Fname;
LenFname:=Length(Fname);
Delete(SFname,LenFname-2,3);
SFname:=SFname+'txt';
Memo1.Clear;
ClipBoard.Clear;
WebBrowser1.ExecWB(17,2);
WebBrowser1.ExecWB(12,2);
Memo1.PasteFromClipboard; //error prompt:'试图激活未注册的丢弃目标'
Memo1.Lines.SaveToFile(SFname);
end;
end.