word to txt

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.