各位老師與大大
我使用以下的方式複製資料夾
[code delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
const
_i32MB=32*1024*1024;
type
TForm1 = class(TForm)
btnCopy: TButton;
progressBarBySize: TProgressBar;
progressBarByNum: TProgressBar;
EditSrc: TEdit;
editTar: TEdit;
Label1: TLabel;
Label2: TLabel;
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;
slSrcFiles : TStringList ;
// 輸入: 要查詢的路徑(要含 *.*) , 要存放檔案大小總和的變數(用 int64避免4GB問題)
// 傳回值: 檔案總數
// 檔案列表會存放到 slSrcFiles 中, 此物件需在外部宣告
implementation
{$R *.dfm}


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 ;
Showmessage('複製完成');
end ;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
getmem(pBuf,_i32MB) ;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
freemem(pBuf,_i32MB) ;
end;

end.

[/code]


但是出現了一個問題就是只要資料夾沒有檔案
目的地無法產生
請各位老師與大大協助一下
萬般感激

1. procedure TForm1.btnCopyClick(Sender: TObject);
2. var
3. i64Size: int64 ;
4. sTarPath, sTarFile, sSrcFile : string ;
5. iSrcLen : integer ;
6. i : integer ;
7. begin
8. i64Size:=0 ;
9. slSrcFiles:=TStringList.Create ;
10. forceDirectories(sTarPath) ;
11. try
12. // 計算目錄下的檔案總數及檔案大小總和
13. iNumofFiles:=TravelTree(EditSrc.Text '\*.*',i64Size) ;
14. i64SizeOfFiles:=i64Size ;
15. // 進度列用 百分比 計算
16. progressbarByNum.Max:=100 ;
17. progressbarBySize.Max:=100 ;
18. progressbarByNum.Position:=0 ;
19. progressbarBySize.Position:=0 ;
20. i:=slSrcFiles.Count-1 ;
21. iSrcLen:=length(editSrc.text) 1 ;
22. sTarPath:=editTar.text ;
23. ......

把紅字部份移到 TRY 以外試試看,
沒有研究你的CODE, 但放在 TRY 的那麼裡面, 有可能前面的程式已經引發 EXCEPT 所以不會跑到 FORCEDIECTOIES,
另外, 使用 FORCEDIRECTORIES 沒有必要加 IF , 因為這個FUCNTION本身就會自已判斷, 存在就不會建立

編輯記錄

感謝版主的回覆
我試了
但是出現錯誤訊息,訊息如下

Unable to Create directory

可否請版主 在幫我檢查一下

我改的地方如下


[code delphi]

procedure TForm1.btnCopyClick(Sender: TObject);
var
i64Size: int64 ;
sTarPath, sTarFile, sSrcFile : string ;
iSrcLen : integer ;
i : integer ;
begin
i64Size:=0 ;
slSrcFiles:=TStringList.Create ;
forceDirectories(sTarPath) ;
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 ;
Showmessage('複製完成');
end ;

[/code]


萬般感激

編輯記錄

抱歉, 並沒有很仔細看你的程式

forceDirectories(sTarPath) ;

你的問題出現在 sTarPath變數沒有值, 所以這段應該擺到 sTarPath 指定值之後, 就不會有錯誤了

感謝版主的回覆
我不太能理解
可否詳細說明一下放置的地方

sTarFile:=sTarPath+copy(sSrcFile,iSrcLen,maxint) ;  
/* 移到這邊*/
===================引 用 kevinsoung 文 章===================
感謝版主的回覆
我不太能理解
可否詳細說明一下放置的地方

感謝版主的回覆
我會去試試看看
萬般感激