Delphi中关于文件、目录操作的函数 







来源：大富翁 







关于文件、目录操作 







Chdir('c:\abcdir');   // 转到目录



Mkdir('dirname');     //建立目录



DirectoryExists('dirname') //判斷目錄是否存在



Rmdir('dirname');     //删除目录(目錄不存在會報異常)



GetCurrentDir;        //取当前目录名，无'\'



Getdir(0,s);          //取工作目录名s:='c:\abcdir';



Deletfile('abc.txt'); //删除文件



Renamefile('old.txt','new.txt');         //文件更名



ExtractFilename(filelistbox1.filename);  //取文件名



ExtractFileExt(filelistbox1.filename);   //取文件后缀 











目录处理函数三则:DelTree,XCopy,Move







private



{ Private declarations }



procedure _XCopy(ASourceDir:String; ADestDir:String);



procedure _Move(ASourceDir:String; ADestDir:String);



procedure _DelTree(ASourceDir:String);







//----------------------------------------------------------



procedure TForm1._XCopy(ASourceDir:String; ADestDir:String);



var



FileRec:TSearchrec;



Sour:String;



Dest:String;



begin



Sour:=ASourceDir;



Dest:=ADestDir;







if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';



if Dest[Length(Dest)]<>'\' then Dest := Dest + '\';







if not DirectoryExists(ASourceDir) then



begin



ShowMessage('来源目录不存在!!');



exit;



end;







if not DirectoryExists(ADestDir) then



begin



ForceDirectories(ADestDir);



end;







if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then



repeat



if ((FileRec.Attr and faDirectory) <> 0) then



begin



if (FileRec.Name<>'.') and (FileRec.Name<>'..') then



begin



_XCopy(Sour+FileRec.Name,Dest+FileRec.Name);



end;



end



else



begin



CopyFile(PChar(Sour+FileRec.Name),PChar(Dest+FileRec.Name),false);



end;



until FindNext(FileRec)<>0;







FindClose(FileRec);







end;



//------------------------------------------------------------------



procedure TForm1._Move(ASourceDir:String; ADestDir:String);



var



FileRec:TSearchrec;



Sour:String;



Dest:String;



begin



Sour:=ASourceDir;



Dest:=ADestDir;







if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';



if Dest[Length(Dest)]<>'\' then Dest := Dest + '\';







if not DirectoryExists(ASourceDir) then



begin



ShowMessage('来源目录不存在!!');



exit;



end;







if not DirectoryExists(ADestDir) then



begin



ForceDirectories(ADestDir);



end;







if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then



repeat



if ((FileRec.Attr and faDirectory) <> 0) then



begin



if (FileRec.Name<>'.') and (FileRec.Name<>'..') then



begin



_XCopy(Sour+FileRec.Name,Dest+FileRec.Name);







_DelTree(Sour+FileRec.Name);







FileSetAttr(Sour+FileRec.Name,faArchive);



RemoveDir(Sour+FileRec.Name);



end;



end



else



begin



CopyFile(PChar(Sour+FileRec.Name),PChar(Dest+FileRec.Name),false);







FileSetAttr(Sour+FileRec.Name,faArchive);



deletefile(Sour+FileRec.Name);



end;



until FindNext(FileRec)<>0;







FindClose(FileRec);







FileSetAttr(Sour,faArchive);



RemoveDir(Sour);







end;



//-----------------------------------------------------------



procedure TForm1._DelTree(ASourceDir:String);



var



FileRec:TSearchrec;



Sour:String;



begin



Sour:=ASourceDir;



if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';







if not DirectoryExists(ASourceDir) then



begin



ShowMessage('来源目录不存在!!');



exit;



end;







if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then



repeat



//if (FileRec.Attr = faDirectory) then



if ((FileRec.Attr and faDirectory) <> 0) then



begin



if (FileRec.Name<>'.') and (FileRec.Name<>'..') then



begin



_DelTree(Sour+FileRec.Name);







FileSetAttr(Sour+FileRec.Name,faArchive);



RemoveDir(Sour+FileRec.Name);



end;



end



else



begin



FileSetAttr(Sour+FileRec.Name,faArchive);



deletefile(Sour+FileRec.Name);



end;



until FindNext(FileRec)<>0;







FindClose(FileRec);







FileSetAttr(Sour,faArchive);



RemoveDir(Sour);







end;  











利用递归实现删除某一目录下所有文件







var Form1: TForm1;



rec_stack:array [1..30] of TSearchRec;



rec_pointer:integer;



Del_Flag:Boolean;



---------------------------------------------------------------



procedure TForm1.DeleteTree(s:string);



VAR searchRec:TSearchRec;



begin



if FindFirst(s+'\*.*', faAnyFile, SearchRec)=0 then



repeat



if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then



begin



if (SearchRec.Attr and faDirectory>0) then



begin



rec_stack[rec_pointer]:=SearchRec;



rec_pointer:=rec_pointer-1;



DeleteTree(s+'\'+SearchRec.Name);



rec_pointer:=rec_pointer+1;



SearchRec:=rec_stack[rec_pointer];



end



else



begin



try



FileSetAttr(s+'\'+SearchRec.Name,faArchive);



DeleteFile(s+'\'+SearchRec.Name);



except



Application.MessageBox(PChar('Delete file:'+s+'\'+SearchRec.Name+' Error!'),'Info',MB_OK);



Del_Flag:=False;



end;



end;



end;



until (FindNext(SearchRec)<>0);



FindClose(SearchRec);



if rec_pointer<30 then



begin



try



FileSetAttr(s,faArchive);



RemoveDir(s);



except



Application.MessageBox(PChar('Delete Directory:'+s+' Error!'),'Info',MB_OK);



Del_Flag:=False;



end;



end;



end;



---------------------------------------------------------



Del_Flag:=True;



rec_pointer:=30;



DeleteTree('c:\temp');



if Del_Flag then Application.MessageBox(PChar('目录c:\temp的内容已成功清除!'),'信息',MB_OK);  











轻轻松松查找文件



在平常的编程当中，经常会碰到查找某一个目录下某一类文件或者所有文件的问题，为了适应不同的需要，我们经常不得不编写大量的类似的代码，有没有可能写一个通用的查找文件的程序，找到一个文件后就进行处理的呢？这样我们只要编写处理文件的部分就可以了，不需要编写查找文件的部分！答案是肯定的。下面的这个程序就能实现这个功能！



//说明：



//TFindCallBack为回调函数，FindFile函数找到一个匹配的文件之后就会调用这个函数。



//TFindCallBack的第一个参数找到的文件名，你在回调函数中可以根据文件名进行操作。



//TFindCallBack的第二个参数为找到的文件的记录信息，是一个TSearchRec结构。



//TFindCallBack的第三、四个参数分别为决定是否终止文件的查找，临时决定是否查找某个子目录！



//FindFile的参数：



//第一个决定是否退出查找，应该初始化为false；



//第二个为要查找路径；



//第三个为文件名，可以包含Windows所支持的任何通配符的格式；默认所有的文件



//第四个为回调函数，默认为空



//第五个决定是否查找子目录，默认为查找子目录



//第六个决定是否在查找文件的时候处理其他的消息，默认为处理其他的消息



//若有意见和建议请E_Mail：Kingron@163.net











type



TFindCallBack=procedure (const filename:string;const info:TSearchRec;var bQuit,bSub:boolean);







procedure FindFile(var quit:boolean;const path: String;const filename:string='*.*';



proc:TFindCallBack=nil;bSub:boolean=true;const bMsg:boolean=true);



var



fpath: String;



info: TsearchRec;







procedure ProcessAFile;



begin



if (info.Name<>'.') and (info.Name<>'..') and ((info.Attr and faDirectory)<>faDirectory) then



begin



if assigned(proc) then



proc(fpath+info.FindData.cFileName,info,quit,bsub);



end;



end;







procedure ProcessADirectory;



begin



if (info.Name<>'.') and (info.Name<>'..') and ((info.attr and fadirectory)=fadirectory) then



findfile(quit,fpath+info.Name,filename,proc,bsub,bmsg);



end;







begin



if path[length(path)]<>'\' then



fpath:=path+'\'



else



fpath:=path;



try



if 0=findfirst(fpath+filename,faanyfile and (not fadirectory),info) then



begin



ProcessAFile;



while 0=findnext(info) do



begin



ProcessAFile;



if bmsg then application.ProcessMessages;



if quit then



begin



findclose(info);



exit;



end;



end;



end;



finally



findclose(info);



end;



try



if bsub and (0=findfirst(fpath+'*',faanyfile,info)) then



begin



ProcessADirectory;



while findnext(info)=0 do



ProcessADirectory;



end;



finally



findclose(info);



end;



end;



例子：



procedure aaa(const filename:string;const info:tsearchrec;var quit,bsub:boolean);



begin



form1.listbox1.Items.Add(filename);



quit:=form1.qqq;



bsub:=form1.checkbox1.Checked;



end;







procedure TForm1.Button1Click(Sender: TObject);



begin



listbox1.Clear;



qqq:=false;



button1.Enabled:=false;



findfile(qqq,edit1.text,edit2.text,aaa,checkbox1.checked,checkbox2.checked);



showmessage(inttostr(listbox1.items.count));



button1.Enabled:=true;



end;







procedure TForm1.Button2Click(Sender: TObject);



begin



qqq:=true;



end;