unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComObj, FileCtrl;
type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Button2: TButton; Label1: TLabel; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm} procedure wordtotxt(sorstr: String; desstr: String); var Test:Variant; begin Test:=CreateOleObject('Word.Application'); Test.Documents.Open(sorstr); Test.ActiveDocument.SaveAs(desstr,2,False,'',True,'',False,False,False,False,False,1200,False,False); Test.Quit; end;
function DeletePath(mDirName: string): Boolean; { 返回删除指定目录是否成功 } var vSearchRec: TSearchRec; vPathName: string; K: Integer; begin Result := True; vPathName := mDirName + '/*.*'; K := FindFirst(vPathName, faAnyFile, vSearchRec); while K = 0 do begin if (vSearchRec.Attr and faDirectory > 0) and (Pos(vSearchRec.Name, '..') = 0) then begin FileSetAttr(mDirName + '/' + vSearchRec.Name, faDirectory); Result := DeletePath(mDirName + '/' + vSearchRec.Name); end else if Pos(vSearchRec.Name, '..') = 0 then begin FileSetAttr(mDirName + '/' + vSearchRec.Name, 0); Result := DeleteFile(PChar(mDirName + '/' + vSearchRec.Name)); end; if not Result then Break; K := FindNext(vSearchRec); end; FindClose(vSearchRec); Result := RemoveDir(mDirName); end; { DeletePath }
procedure DealWithPath(mDirName: string); { 返回删除指定目录是否成功 } var vSearchRec: TSearchRec; vPathName: string; K: Integer; sorname, desname : string; begin vPathName := mDirName + '/*.doc'; K := FindFirst(vPathName, faAnyFile, vSearchRec); while K = 0 do begin if (vSearchRec.Attr and faDirectory > 0) and (Pos(vSearchRec.Name, '..') = 0) then begin DealWithPath(mDirName + '/' + vSearchRec.Name); end else if Pos(vSearchRec.Name, '..') = 0 then begin sorname := vSearchRec.Name; setlength(desname,length(sorname)-4); strLCopy(Pchar(desname), Pchar(sorname), length(sorname) - 4); desname := mDirName + '/' + desname + '.txt'; sorname := mDirName + '/' + vSearchRec.Name; wordtotxt(sorname, desname); end; K := FindNext(vSearchRec); end; FindClose(vSearchRec); end; { DeletePath }
procedure TForm1.Button1Click(Sender: TObject); var Test:Variant; begin Test:=CreateOleObject('Word.Application'); Test.Documents.Open('c:/181.doc'); Test.ActiveDocument.SaveAs('c:/Test.Txt',2,False,'',True,'',False,False,False,False,False,1200,False,False); Test.Quit; showmessage('ok'); end;
procedure TForm1.Button4Click(Sender: TObject); begin halt(1); end;
procedure TForm1.Button3Click(Sender: TObject); begin if length(edit1.Text) = 0 then begin ShowMessage('请选择文件夹'); abort(); end; DealWithPath(edit1.Text); ShowMessage('完成'); end;
procedure TForm1.Button2Click(Sender: TObject); var Dir : string; begin Dir := Extractfiledir(Application.ExeName); if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],1000) then Edit1.Text := Dir;
end;
end.