無法複製空資料夾問題\ |
答題得分者是:P.D.
|
kevinsoung
一般會員 發表:36 回覆:41 積分:15 註冊:2011-11-09 發送簡訊給我 |
各位老師與大大
我使用以下的方式複製資料夾 [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] 但是出現了一個問題就是只要資料夾沒有檔案 目的地無法產生 請各位老師與大大協助一下 萬般感激 |
P.D.
版主 發表:603 回覆:4038 積分:3874 註冊:2006-10-31 發送簡訊給我 |
把紅字部份移到 TRY 以外試試看, 沒有研究你的CODE, 但放在 TRY 的那麼裡面, 有可能前面的程式已經引發 EXCEPT 所以不會跑到 FORCEDIECTOIES, 另外, 使用 FORCEDIRECTORIES 沒有必要加 IF , 因為這個FUCNTION本身就會自已判斷, 存在就不會建立
編輯記錄
P.D. 重新編輯於 2011-12-23 02:25:16, 註解 無‧
|
kevinsoung
一般會員 發表:36 回覆:41 積分:15 註冊:2011-11-09 發送簡訊給我 |
感謝版主的回覆
我試了 但是出現錯誤訊息,訊息如下 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] 萬般感激
編輯記錄
|
P.D.
版主 發表:603 回覆:4038 積分:3874 註冊:2006-10-31 發送簡訊給我 |
|
kevinsoung
一般會員 發表:36 回覆:41 積分:15 註冊:2011-11-09 發送簡訊給我 |
|
P.D.
版主 發表:603 回覆:4038 積分:3874 註冊:2006-10-31 發送簡訊給我 |
sTarFile:=sTarPath+copy(sSrcFile,iSrcLen,maxint) ;
/* 移到這邊*/ ===================引 用 kevinsoung 文 章=================== 感謝版主的回覆 我不太能理解 可否詳細說明一下放置的地方 |
kevinsoung
一般會員 發表:36 回覆:41 積分:15 註冊:2011-11-09 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |