程式技巧(Delphi) - 包含子目錄的檔案複製 ( 有 檔案個數 及 檔案大小 2個進度列)

這個程式是拿來當範例用的, 還有許多地方可以加強, 例如對目的檔案的日期、屬性等訊息並未複製, 只有檔案內容的複製. 未處理 unicode 檔案, 未檢查空間是否足夠, 未用多執行緒加速...等. 不過已可達到 複製包含子目錄下的檔案, 並顯示進度列這 2 個基本需求

unit Utest; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; const _i32MB=32*1024*1024 ; type TForm1 = class(TForm) LabelSrc: TLabel; EditSrc: TEdit; LabelTar: TLabel; EditTar: TEdit; btnCopy: TButton; ProgressBarByNum: TProgressBar; ProgressBarBySize: TProgressBar; procedure btnCopyClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } iNumofFiles : integer ; // 記錄目錄下檔案總數 i64SizeofFiles : int64 ; // 記錄目錄下檔案大小總和 pBuf : pointer ; function DoCopyFile(sSrcFile,sTarFile:string;iLeftNum:integer;var i64LeftSize:int64):boolean ; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var slSrcFiles : TStringList ; // 輸入: 要查詢的路徑(要含 *.*) , 要存放檔案大小總和的變數(用 int64避免4GB問題) // 傳回值: 檔案總數 // 檔案列表會存放到 slSrcFiles 中, 此物件需在外部宣告 function TravelTree(sRoot:string; var i64TotalSize:int64):integer ; var fd : WIN32_FIND_DATA ; h : Thandle ; sPath, sName : string ; begin result:=0 ; h:=findfirstfile(pchar(sRoot),FD) ; if h=INVALID_HANDLE_VALUE then exit ; sPath:=ExtractFilePath(sRoot) ; repeat sName:=strpas(fd.cFilename) ; if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then begin // 若是目錄則用 recursive if (sName<>'.') and (sName<>'..') then result:=result+TravelTree(sPath+sName+'\*.*',i64totalSize) ; end else begin result:=result+1 ; slSrcFiles.Add(sPath+sName) ; if fd.nFileSizeHigh=0 then i64TotalSize:=i64TotalSize+fd.nFileSizeLow else i64TotalSize:=i64TotalSize+(int64(fd.nFileSizeHigh)shl 32)+fd.nFileSizeLow ; end ; until FindNextFile(h,fd)=false ; windows.FindClose(h) ; end ; function TForm1.DoCopyFile(sSrcFile,sTarFile:string;iLeftNum:integer;var i64LeftSize:int64):boolean ; var fsSrc, fsTar : TFileStream ; sPath : string ; iReadSize : integer ; begin sPath:=extractFilePath(sTarFile) ; if not directoryExists(sPath) then forceDirectories(sPath) ; result:=true ; try fsSrc:=TFileStream.Create(sSrcFile,fmOpenRead); fsTar:=TFileStream.Create(sTarFile,fmCreate); try repeat iReadSize:=fsSrc.Read(pBuf^,_i32MB) ; fsTar.Write(pBuf^,iReadSize) ; i64LeftSize:=i64LeftSize-iReadSize ; // 更新 大小 的進度列 progressBarBySize.Position:=round((i64SizeOfFiles-i64LeftSize)/i64SizeOfFiles*100) ; // 處理訊息, 例如中斷執行 application.ProcessMessages ; until iReadSize<_i32MB ; finally fsSrc.Free ; fsTar.Free ; end ; // 更新 個數 的進度列 progressBarByNum.Position:=round((iNumOfFiles-iLeftNum)/iNumOfFiles*100) ; except result:=false ; end ; end ; procedure TForm1.btnCopyClick(Sender: TObject); var i64Size: int64 ; sTarPath, sTarFile, sSrcFile : string ; iSrcLen : integer ; i : integer ; begin i64Size:=0 ; slSrcFiles:=TStringList.Create ; try // 計算目錄下的檔案總數及檔案大小總和 iNumofFiles:=TravelTree(EditSrc.Text+'\*.*',i64Size) ; i64SizeOfFiles:=i64Size ; // 進度列用 百分比 計算 progressbarByNum.Max:=100 ; progressbarBySize.Max:=100 ; progressbarByNum.Position:=0 ; progressbarBySize.Position:=0 ; i:=slSrcFiles.Count-1 ; iSrcLen:=length(editSrc.text)+1 ; sTarPath:=editTar.text ; if not directoryExists(sTarPath) then forceDirectories(sTarPath) ; while i>=0 do begin // 來源檔名 sSrcFile:=slSrcFiles[i] ; // 目的檔名 sTarFile:=sTarPath+copy(sSrcFile,iSrcLen,maxint) ; // 複製每一個檔案 DoCopyFile(sSrcFile,sTarFile, i, i64Size) ; dec(i) ; end ; finally slSrcFiles.Free ; end ; end; procedure TForm1.FormCreate(Sender: TObject); begin getmem(pBuf,_i32MB) ; end; procedure TForm1.FormDestroy(Sender: TObject); begin freemem(pBuf,_i32MB) ; end; end.