Delphi 遍历文件夹后无法删除问题。

Question

想要实现的功能：遍历文件夹后将文件上传到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;

Answer 1

如果你用的XE，用这句就行了
TDirectory.Delete(sDirectory, True);如果用的D7之类的，当我没说

Answer 2

uses
  Winapi.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;

Answer 3

@FlashDance 这个方法我试过 ，也不行 ，只要使用了FindFirst. FindNext   之后 文件目录就删除不了 ，手动删除也报错。

Answer 4

我遍历通过如下方法来的，我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;

Answer 5

你这么写是“Winapi.Windows.FindClose”，不错才怪
FindClose(vSearchRec)
改为
System.SysUtils.FindClose(SearchRec);

Answer 6

你用了几个FindClose，就要对应改几处，就是它的问题，和删除代码无关
文件被占用呢，不信你手动删也一样

Answer 7

亲测无问题（除了代码质量不高）：
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;

Answer 8

我都晕死了，
1.我随便找个目录 调用我那个方法（GetAllDirFile） 然后删除（DelFileDir） 是可以删除的
2.我Copy到的目录在（C:\Temp\xxxx），如果我不调用GetAllDirFile方法，直接删除DelFileDir(‘C:\Temp\xxxx’);是可以的，如果我调用了 那么就删不掉了（P.S.:在程序关闭后 有些文件目录的文件夹可以被删除，空的删除不掉），有文件的文件夹在程序未关闭前 ，文件夹不能被访问,程序退出，文件夹就被删除， 如下图

Answer 9

@FlashDance
可以加分  呵呵