隨筆 - 6 文章 - 129 trackbacks - 0

<

2025年7月

>

日

一

二

三

四

五

六

29

30

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

1

2

3

4

5

6

7

8

9

常用鏈接

留言簿(14)

隨筆檔案(6)

文章分類(467)

文章檔案(423)

相冊

收藏夾(18)

JAVA

ajax教程.chm
DWR中文文檔
Hibernate API
Hibernate3.0中文參考文檔
jakarta commons
JAVASCRIPT手冊
JAVA堂
Spring Framework API 2.0
Struts 2 Core 2.0.9 API

搜索

積分與排名

積分 - 828827
排名 - 49

閱讀排行榜

評(píng)論排行榜

Delphi中關(guān)于文件、目錄操作的函數(shù)

Delphi中關(guān)于文件、目錄操作的函數(shù) 







來源：大富翁 







關(guān)于文件、目錄操作 







Chdir('c:\abcdir');   // 轉(zhuǎn)到目錄



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



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



Rmdir('dirname');     //刪除目錄(目錄不存在會(huì)報(bào)異常)



GetCurrentDir;        //取當(dāng)前目錄名，無'\'



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



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



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



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



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











目錄處理函數(shù)三則: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;  











利用遞歸實(shí)現(xiàn)刪除某一目錄下所有文件







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的內(nèi)容已成功清除!'),'信息',MB_OK);  











輕輕松松查找文件



在平常的編程當(dāng)中，經(jīng)常會(huì)碰到查找某一個(gè)目錄下某一類文件或者所有文件的問題，為了適應(yīng)不同的需要，我們經(jīng)常不得不編寫大量的類似的代碼，有沒有可能寫一個(gè)通用的查找文件的程序，找到一個(gè)文件后就進(jìn)行處理的呢？這樣我們只要編寫處理文件的部分就可以了，不需要編寫查找文件的部分！答案是肯定的。下面的這個(gè)程序就能實(shí)現(xiàn)這個(gè)功能！



//說明：



//TFindCallBack為回調(diào)函數(shù)，F(xiàn)indFile函數(shù)找到一個(gè)匹配的文件之后就會(huì)調(diào)用這個(gè)函數(shù)。



//TFindCallBack的第一個(gè)參數(shù)找到的文件名，你在回調(diào)函數(shù)中可以根據(jù)文件名進(jìn)行操作。



//TFindCallBack的第二個(gè)參數(shù)為找到的文件的記錄信息，是一個(gè)TSearchRec結(jié)構(gòu)。



//TFindCallBack的第三、四個(gè)參數(shù)分別為決定是否終止文件的查找，臨時(shí)決定是否查找某個(gè)子目錄！



//FindFile的參數(shù)：



//第一個(gè)決定是否退出查找，應(yīng)該初始化為false；



//第二個(gè)為要查找路徑；



//第三個(gè)為文件名，可以包含Windows所支持的任何通配符的格式；默認(rèn)所有的文件



//第四個(gè)為回調(diào)函數(shù)，默認(rèn)為空



//第五個(gè)決定是否查找子目錄，默認(rèn)為查找子目錄



//第六個(gè)決定是否在查找文件的時(shí)候處理其他的消息，默認(rèn)為處理其他的消息



//若有意見和建議請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;

posted on 2010-02-25 15:31 Ke 閱讀(996) 評(píng)論(0) 編輯收藏所屬分類: delphi

新用戶注冊刷新評(píng)論列表


只有注冊用戶登錄后才能發(fā)表評(píng)論。




網(wǎng)站導(dǎo)航: 博客園 IT新聞 Chat2DB C++博客博問管理
相關(guān)文章: VCLSkin第三方包 Delphi遍歷文件夾及子文件夾為TListBox組件添加水平滾動(dòng)條 Delphi中Format與FormatDateTime函數(shù)詳解 Delphi+Codesoft 7.0 ODAC的安裝和使用(odac570src_0.28) Delphi中關(guān)于文件、目錄操作的函數(shù) Delphi中TApplication類用鼠標(biāo)拖動(dòng)無標(biāo)題窗口,窗口內(nèi)放的是Image Delphi 日誌記錄相關(guān)

常用鏈接

留言簿(14)

隨筆檔案(6)

文章分類(467)

文章檔案(423)

相冊

收藏夾(18)

JAVA

搜索

積分與排名

最新評(píng)論

閱讀排行榜

評(píng)論排行榜