2005. december 1., csütörtök

Delete a complete folder


Problem/Question/Abstract:

How to delete a complete folder

Answer:

Solve 1:

I use this code to delete all files in a folder and/ or the folder itself:

function DeleteFolder(FolderName: string; LeaveFolder: Boolean): Boolean;
var
  r: TshFileOpStruct;
begin
  Result := False;
  if not DirectoryExists(FolderName) then
    Exit;
  if LeaveFolder then
    FolderName := FolderName + ' *.* '
  else if FolderName[Length(FolderName)] = ' \ ' then
    Delete(FolderName, Length(FolderName), 1);
  FillChar(r, SizeOf(r), 0);
  r.wFunc := FO_DELETE;
  r.pFrom := PChar(FolderName);
  r.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
  Result := ((ShFileOperation(r) = 0) and (not r.fAnyOperationsAborted));
end;


Solve 2:

uses
  ShellAPI;

function DeleteDir(const Directory: string);
var
  FileOp: TSHFileOpStruct;
begin
  FileOp.Wnd := Application.Handle;
  FileOp.wFunc := FO_DELETE;
  FileOp.pFrom := PChar(Directory + #0);
  FileOp.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
  Result := SHFileOperation(FileOp) = 0;
end;

Add FOF_SILENT to fFlags if you don't want a dialog.


Solve 3:

The following will send a directory to the recycle bin:

procedure ToRecycle(AHandle: THandle; const ADirName: string);
var
  SHFileOpStruct: TSHFileOpStruct;
  DirName: PChar;
  BufferSize: Cardinal;
begin
  BufferSize := Length(ADirName) + 1 + 1;
  GetMem(DirName, BufferSize);
  try
    FillChar(DirName^, BufferSize, 0);
    StrCopy(DirName, PChar(ADirName));
    with SHFileOpStruct do
    begin
      Wnd := AHandle;
      wFunc := FO_DELETE;
      pFrom := DirName;
      pTo := nil;
      fFlags := FOF_ALLOWUNDO;
      fAnyOperationsAborted := False;
      hNameMappings := nil;
      lpszProgressTitle := nil;
    end;
    if SHFileOperation(SHFileOpStruct) <> 0 then
      RaiseLastWin32Error;
  finally
    FreeMem(DirName, BufferSize);
  end;
end;


Solve 4:

procedure DeleteDir(aDir: string);
{delete directory & everything in it}
var
  T: TSHFileOpStruct;
begin
  Fillchar(T, SizeOf(T), #0);
  with T do
  begin
    Wnd := 0; {no handle -> no animation}
    wFunc := FO_DELETE;
    pFrom := pchar(aDir + #0#0);
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION; {just do it}
  end;
  Application.ProcessMessages;
  if (SHFileOperation(T) <> 0) then
    RemoveDir(aDir);
end;


Solve 5:

The command-line program DELTREE.EXE that comes with Windows removes a directory with all its files and subdirectories. To mimic this behaviour in Delphi we can use the following procedure that uses the FindFirst, FindNext and FindClose functions to perform the file and directory search:

uses FileCtrl;

procedure DelTree(const Directory: TFileName);
var
  DrivesPathsBuff: array[0..1024] of char;
  DrivesPaths: string;
  len: longword;
  ShortPath: array[0..MAX_PATH] of char;
  dir: TFileName;
  procedure rDelTree(const Directory: TFileName);
    // Recursively deletes all files and directories
    // inside the directory passed as parameter.
  var
    SearchRec: TSearchRec;
    Attributes: LongWord;
    ShortName, FullName: TFileName;
    pname: pchar;
  begin
    if FindFirst(Directory + '*', faAnyFile and not faVolumeID,
      SearchRec) = 0 then
    begin
      try
        repeat // Processes all files and directories
          if SearchRec.FindData.cAlternateFileName[0] = #0 then
            ShortName := SearchRec.Name
          else
            ShortName := SearchRec.FindData.cAlternateFileName;
          FullName := Directory + ShortName;
          if (SearchRec.Attr and faDirectory) <> 0 then
          begin
            // It's a directory
            if (ShortName <> '.') and (ShortName <> '..') then
              rDelTree(FullName + '\');
          end
          else
          begin
            // It's a file
            pname := PChar(FullName);
            Attributes := GetFileAttributes(pname);
            if Attributes = $FFFFFFFF then
              raise EInOutError.Create(SysErrorMessage(GetLastError));
            if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
              SetFileAttributes(pname, Attributes and not
                FILE_ATTRIBUTE_READONLY);
            if Windows.DeleteFile(pname) = False then
              raise EInOutError.Create(SysErrorMessage(GetLastError));
          end;
        until FindNext(SearchRec) <> 0;
      except
        FindClose(SearchRec);
        raise;
      end;
      FindClose(SearchRec);
    end;
    if Pos(#0 + Directory + #0, DrivesPaths) = 0 then
    begin
      // if not a root directory, remove it
      pname := PChar(Directory);
      Attributes := GetFileAttributes(pname);
      if Attributes = $FFFFFFFF then
        raise EInOutError.Create(SysErrorMessage(GetLastError));
      if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
        SetFileAttributes(pname, Attributes and not
          FILE_ATTRIBUTE_READONLY);
      if Windows.RemoveDirectory(pname) = False then
      begin
        raise EInOutError.Create(SysErrorMessage(GetLastError));
      end;
    end;
  end;
  // ----------------
begin
  DrivesPathsBuff[0] := #0;
  len := GetLogicalDriveStrings(1022, @DrivesPathsBuff[1]);
  if len = 0 then
    raise EInOutError.Create(SysErrorMessage(GetLastError));
  SetString(DrivesPaths, DrivesPathsBuff, len + 1);
  DrivesPaths := Uppercase(DrivesPaths);
  len := GetShortPathName(PChar(Directory), ShortPath, MAX_PATH);
  if len = 0 then
    raise EInOutError.Create(SysErrorMessage(GetLastError));
  SetString(dir, ShortPath, len);
  dir := Uppercase(dir);
  rDelTree(IncludeTrailingBackslash(dir));
end;

Sample calls

This code will remove the directory C:\TEMP\A123:

DelTree('C:\TEMP\A123');

And this code will wipe out the diskette in drive A:

DelTree('A:'); // or DelTree('A:\');


WARNING: The procedure DelTree presented here erases files and directories, and they might not be recoverable later. It is provided in the belief that it is useful, but you use it at our own risk.

Nincsenek megjegyzések:

Megjegyzés küldése