想要實作的功能：遍歷檔案夾后將檔案上傳到FTP服務器上，將已上傳的檔案COPY到BACKUP檔案夾下，然后再已上傳的檔案及檔案夾洗掉。
問題：當第一次遍歷檔案夾成功上傳后，要洗掉檔案夾時再次遍歷就無法洗掉檔案夾了，只能洗掉檔案。請問各位大大，是否在我第一次遍歷后沒有釋放檔案還是怎么的。我要如何做才能洗掉？代碼如下：
{-------------------------------------------------------------------------------
Description: 上傳目錄按鈕
-------------------------------------------------------------------------------}
procedure TMainForm.btn_UploadDirectoryClick(Sender: TObject);
function DoUploadDir(idftp:TIdFTP;sDirName:String;sToDirName:String;sDirBackup:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin
//先保存目前的目錄
sCurDir:=GetCurrentDir;
ChDir(sDirName);
//idFTP.ChangeDir(AnsiToUtf8(sToDirName));
idFTP.ChangeDir(sToDirName);
hFindFile:=FindFirstFile( '*.* ',FindFileData);
Application.ProcessMessages;
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile= '.') or (tfile= '..') or (uppercase(tfile)='BACKUP') then
Continue;
if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then
begin
try
ForceDirectories(sDirBackup+'\'+tfile);
//IdFTP.MakeDir(AnsiToUtf8(tfile));
IdFTP.MakeDir(tfile);
mmo_Log.Lines.Add(DateTimeToStr(Now) + ' ' + '新建資料夾：' + tfile);
except
end;
DoUploadDir(idftp,sDirName+ '\'+tfile,tfile,sDirBackup+'\'+tfile);
idftp.ChangeDir('..');
Application.ProcessMessages;
end
else
begin
//IdFTP.Put(tfile, AnsiToUtf8(tfile));
IdFTP.Put(tfile, tfile);
mmo_Log.Lines.Add(DateTimeToStr(Now) + ' ' + '上傳檔案：' + tfile);
CopyFile(PChar(sDirName+ '\'+tfile), PChar(sDirBackup+'\'+tfile),False);
Application.ProcessMessages;
end;
until FindNextFile(hFindFile,FindFileData)=false;
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原來的目錄下
ChDir(sCurDir);
result:=true;
end;
var
strPath,strToPath,temp: string;
begin
if idftp_Client.Connected=false then
begin
//未連接
with idftp_Client do
try
Passive := True; //被動模式
Username := Trim(edt_UserName.Text);
Password := Trim(edt_UserPassword.Text);
Host := Trim(edt_ServerAddress.Text);
Connect();
Self.ChageDir(edt_CurrentDirectory.Text);
finally
btn_Connect.Enabled := True;
if Connected then
btn_Connect.Caption := '斷開連接';
mmo_Log.Lines.Add(DateTimeToStr(Now) + ' ' + '連接伺服器');
end;
end;
if idftp_Client.Connected then
begin
if chk_AutoUpload.Checked then
begin
if Trim(edt_SourceDirectory.Text)='' then
begin
MessageDlg('源檔案目錄不能為空。',mterror,[mbYes],0);
exit;
end else
strPath := Trim(edt_SourceDirectory.Text);
Self.ChageDir('/');
end else
if SelectDirectory('選擇上傳目錄','',strPath)=False then exit;
//temp := Utf8ToAnsi(idftp_Client.RetrieveCurrentDir);
temp := idftp_Client.RetrieveCurrentDir;
strToPath := temp;
if Length(strToPath) = 1 then
strToPath := strToPath + ExtractFileName(strPath)
else
strToPath := strToPath + '/' + ExtractFileName(strPath);
try
//idftp_Client.MakeDir(AnsiToUtf8(ExtractFileName(strPath)));
idftp_Client.MakeDir(ExtractFileName(strPath));
except
end;
ForceDirectories(strPath+'\BACKUP'); //創建備份目錄
DoUploadDir(idftp_Client,strPath,strToPath,strPath+'\BACKUP');
Self.ChageDir(temp);
DeleteDir(edt_sourceDirectory.Text);
end;
end;
procedure TMainForm.DeleteDir(sDirectory:String);
var
sr:TSearchRec;
sPath,sFile:String;
begin
//檢查目錄名后面是否有'\'
if Copy(sDirectory,Length(sDirectory),1)<>'\'then
sPath:=sDirectory+'\'
else
sPath:=sDirectory;
//------------------------------------------------------------------
if FindFirst(sPath+'*.*',faAnyFile,sr)=0 then
begin
repeat
sFile:=Trim(sr.Name);
if (sFile= '.') or (sFile= '..') or (uppercase(sFile)='BACKUP') then
Continue;
sFile:=sPath+sr.Name;
if(sr.Attr and faDirectory)<>0 then
DeleteDir(sFile)
else if(sr.Attr and faAnyFile)=sr.Attr then
DeleteFile(sFile);//刪除檔案
until FindNext(sr)<>0;
FindClose(sr);
end;
RemoveDir(sPath);
end;
uj5u.com熱心網友回復：
檔案洗掉是異步操作，異步操作還未完成就去刪檔案夾會失敗。可能是這個原因吧？不妨試試程式每次啟動后洗掉上次遺留的空檔案夾。uj5u.com熱心網友回復：
先刪空目錄下的下級, 再洗掉當前目錄uj5u.com熱心網友回復：
如果你用的XE，用這句就行了TDirectory.Delete(sDirectory, True);
如果用的D7之類的，當我沒說
uj5u.com熱心網友回復：
就是因為檔案能洗掉，空檔案夾洗掉不了。
uj5u.com熱心網友回復：
額，剛好用的是D7。我們這套系統是用D7開發的。所以……
uj5u.com熱心網友回復：
網上有這種函式的樓主找找吧
uj5u.com熱心網友回復：
樓主，求助 這個問題解決了嗎？uj5u.com熱心網友回復：
usesWinapi.ShellAPI;
function DelFileDir(const Path: string): Boolean;
var
Fo: TSHFileOpStruct;
begin
FillChar(Fo, SizeOf(Fo), 0);
with Fo do
begin
Wnd := 0;
wFunc := Fo_DELETE;
pFrom := PChar(Path + #0);
pTo := #0#0;
fFlags := FOF_NOCONFIRMATION + FOF_SILENT;
end;
Result := (SHFileOperation(Fo) = 0);
end;
uj5u.com熱心網友回復：
@FlashDance這個方法我試過 ，也不行 ，只要使用了FindFirst. FindNext 之后 檔案目錄就洗掉不了 ，手動洗掉也報錯。
uj5u.com熱心網友回復：
親測完全可以，除非是之前的代碼有問題，或檔案被占用。
uj5u.com熱心網友回復：
我遍歷通過如下方法來的，我New出來的物件都釋放了呀， 我就通過如下方法（GetAllDirFile）遍歷一遍，然后洗掉就洗掉不了。但 程式關閉后， 有一些有檔案的目錄會被洗掉，沒有檔案的目錄洗掉不了function GetAllSubDir(Directory: string; var RetList: TStringList): boolean;
var
SearchRec: TSearchRec;
sTemp: string;
function IsSubDir(SrchRec: TSearchRec): boolean;
begin
if (SrchRec.Attr = faDirectory) and (SrchRec.Name <> '.') and
(SrchRec.Name <> '..') then
Result := True
else
Result := false;
end;
begin
if FindFirst(Directory + '*', faAnyFile or faDirectory, SearchRec) = 0 then
begin
repeat
if IsSubDir(SearchRec) then
begin
sTemp := Directory + SearchRec.Name + '\';
RetList.Add(sTemp);
GetAllSubDir(sTemp, RetList);
end;
until (FindNext(SearchRec) <> 0);
end;
FindClose(SearchRec);
Result := True;
end;
function GetAllDirFile(Directory: string; var RetList: TStringList): boolean;
var
i: Integer;
DirList: TStringList;
SearchRec: TSearchRec;
ExtName: string;
begin
Result := false;
DirList := TStringList.Create;
DirList.Add(Directory + '\');
if not GetAllSubDir(Directory + '\', DirList) then
Exit;
for i := 0 to DirList.Count - 1 do
begin
RetList.Add(DirList.Strings[i]);
if FindFirst(DirList.Strings[i] + '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if SearchRec.Attr = faDirectory then
begin
RetList.Add(DirList.Strings[i] + SearchRec.Name);
end
else
begin
ExtName := ExtractFileExt(DirList.Strings[i] + SearchRec.Name);
if (ExtName <> '.exe') then // Filter the exe file
begin
RetList.Add(DirList.Strings[i] + SearchRec.Name);
end;
end;
until (FindNext(SearchRec) <> 0);
end;
end;
if DirList.Count <= 0 then
RetList.Add(Directory);
FindClose(SearchRec);
FreeAndNil(DirList);
Result := True;
end;
uj5u.com熱心網友回復：
你這么寫是“Winapi.Windows.FindClose”，不錯才怪
FindClose(vSearchRec)
改為
System.SysUtils.FindClose(SearchRec);
uj5u.com熱心網友回復：
改過了，也不行
uj5u.com熱心網友回復：
你用了幾個FindClose，就要對應改幾處，就是它的問題，和洗掉代碼無關
檔案被占用呢，不信你手動刪也一樣
uj5u.com熱心網友回復：
我就用了兩處，都改過了呢，還是一樣的效果uj5u.com熱心網友回復：
親測無問題（除了代碼質量不高）：
procedure TForm1.btn1Click(Sender: TObject);
var
SL:TStringList;
I:Integer;
begin
mmo1.Clear;
SL:=TStringList.Create;
GetAllDirFile('C:\Users\Administrator\Desktop\新建檔案夾\',SL);
mmo1.Lines.AddStrings(SL);
for I := 0 to SL.Count-1 do
DelFileDir(SL.Strings[I]);
FreeAndNil(SL);
end;
procedure TForm1.btn2Click(Sender: TObject);
var
SL:TStringList;
I:Integer;
begin
mmo1.Clear;
SL:=TStringList.Create;
GetAllSubDir('C:\Users\Administrator\Desktop\新建檔案夾\',SL);
mmo1.Lines.AddStrings(SL);
for I := 0 to SL.Count-1 do
DelFileDir(SL.Strings[I]);
FreeAndNil(SL);
end;
uj5u.com熱心網友回復：
我都暈死了，1.我隨便找個目錄 呼叫我那個方法（GetAllDirFile） 然后洗掉（DelFileDir） 是可以洗掉的
2.我Copy到的目錄在（C:\Temp\xxxx），如果我不呼叫GetAllDirFile方法，直接洗掉DelFileDir(‘C:\Temp\xxxx’);是可以的，如果我呼叫了 那么就刪不掉了（P.S.:在程式關閉后 有些檔案目錄的檔案夾可以被洗掉，空的洗掉不掉），有檔案的檔案夾在程式未關閉前 ，檔案夾不能被訪問,程式退出，檔案夾就被洗掉， 如下圖
uj5u.com熱心網友回復：
代碼質量不高，有很多問題，不只是洗掉的問題，分又少，沒什么興趣和時間全部指出。
uj5u.com熱心網友回復：
@FlashDance可以加分 呵呵
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/98923.html
上一篇：delphi 開發web怎樣
下一篇：delphi回圈問題