Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi kompletten Ordner löschen... (https://www.delphipraxis.net/6348-kompletten-ordner-loeschen.html)

FriFra 7. Jul 2003 15:40


kompletten Ordner löschen...
 
Wie kann ich einen Ordner komplett löschen? RemoveDir funktioniert nicht, wenn der Ordner Dateien bzw. Ordner enthällt. Ich wollte es mir eigentlich sparen, den Ordner rekursiv zu durchsuchen und alles einzeln zu löschen... es muss doch auch eine performantere Lösung geben...

Luckie 7. Jul 2003 15:46

Re: kompletten Ordner löschen...
 
Kuck dir mal SHFileOperation an.

sakura 7. Jul 2003 15:49

Re: kompletten Ordner löschen...
 
Du kannst auch hier danach suchen ;-)

Hier im Forum suchenSHFileOperation
SHFileOperationSHFileOperation

...:cat:...

CalganX 7. Jul 2003 15:50

Re: kompletten Ordner löschen...
 
In der Code-Library findest du dazu auch was:
SHFileOperation DoFileWorkSHFileOperation DoFileWork

Chris

FriFra 7. Jul 2003 16:42

Re: kompletten Ordner löschen...
 
Danke @all... :dancer: :dancer2: :firejump: :bounce1: :bounce2: :coder:

Allerdings hat der Beitrag in der Codelibary noch einen kleinen Fehler... Die Deklaration weicht von der Tatsächlichen Funktion ab.

sakura 7. Jul 2003 16:48

Re: kompletten Ordner löschen...
 
@FriFra: In welcher Hinsicht? Ich nutze die Deklaration seit drei Jahren ohne Probleme. Du bist der erste der es anders sieht...

...:cat:...

CalganX 7. Jul 2003 16:51

Re: kompletten Ordner löschen...
 
Er meint vielleicht aFrom, aTo: array of string und aFrom, aTo: Tstrings

Chris

Henni 7. Jul 2003 16:53

Re: kompletten Ordner löschen...
 
Hallo !
probier mal den Code:
Code:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  {$IFDEF LINUX}
  PathSeparator   = '/';
  {$ENDIF LINUX}
  {$IFDEF WIN32}
  DriveLetters    = ['a'..'z', 'A'..'Z'];
  PathDevicePrefix = '\\.\';
  PathSeparator   = '\';
  PathUncPrefix   = '\\';
  {$ENDIF WIN32}

  type
  TDelTreeProgress = function (const FileName: string; Attr: DWORD): Boolean;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
   
  private
    { Private-Deklarationen }
  public
    function DelTree(const Path: string): Boolean;
    function PathRemoveSeparator(const Path: string): string;
    function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings): Boolean;

    function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses filectrl;


function TForm1.DelTree(const Path: string): Boolean;
begin
  Result := DelTreeEx(Path, False, nil);
end;

//------------------------------------------------------------------------------

function TForm1.DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
var
  Files: TStringList;
  LPath: string; // writable copy of Path
  FileName: string;
  I: Integer;
  PartialResult: Boolean;
  Attr: DWORD;
begin
  Result := True;
  Files := TStringList.Create;
  try
    LPath := PathRemoveSeparator(Path);
    BuildFileList(LPath + '\*.*', faAnyFile, Files);
    for I := 0 to Files.Count - 1 do
    begin
      FileName := LPath + '\' + Files[I];
      PartialResult := True;
      // If the current file is itself a directory then recursively delete it
      Attr := GetFileAttributes(PChar(FileName));
      if (Attr <> DWORD(-1)) and ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
        PartialResult := DelTreeEx(FileName, AbortOnFailure, Progress)
      else
      begin
        if Assigned(Progress) then
          PartialResult := Progress(FileName, Attr);
        if PartialResult then
        begin
          // Set attributes to normal in case it's a readonly file
          PartialResult := SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_NORMAL);
          if PartialResult then
            PartialResult := DeleteFile(FileName);
        end;
      end;
      if not PartialResult then
      begin
        Result := False;
        if AbortOnFailure then
          Break;
      end;
    end;
  finally
    FreeAndNil(Files);
  end;
  if Result then
  begin
    // Finally remove the directory itself
    Result := SetFileAttributes(PChar(LPath), FILE_ATTRIBUTE_NORMAL);
    if Result then
    begin
      {$I-}
      RmDir(LPath);
      {$I+}
      Result := IOResult = 0;
    end;
  end;
end;



function TForm1.PathRemoveSeparator(const Path: string): string;
var
  L: Integer;
begin
  L := Length(Path);
  if (L <> 0) and (AnsiLastChar(Path) = PathSeparator) then
    Result := Copy(Path, 1, L - 1)
  else
    Result := Path;
end;

function TForm1.BuildFileList(const Path: string; const Attr: Integer;
  const List: TStrings): Boolean;
var
  SearchRec: TSearchRec;
  R: Integer;
begin
  Assert(List <> nil);
  R := FindFirst(Path, Attr, SearchRec);
  Result := R = 0;
  if Result then
  begin
    while R = 0 do
    begin
      if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        List.Add(SearchRec.Name);
      R := FindNext(SearchRec);
    end;
    Result := R = ERROR_NO_MORE_FILES;
    SysUtils.FindClose(SearchRec);
  end;
end;

//------------------------------------------------------------------------------



procedure TForm1.Button1Click(Sender: TObject);
begin
  if DirectoryExists(edit1.text)then
   begin
     DELTREE(edit1.text);
   end;
end;

end.

grüße
Henni

FriFra 7. Jul 2003 16:54

Re: kompletten Ordner löschen...
 
Zitat:

Zitat von Chakotay1308
Er meint vielleicht aFrom, aTo: array of string und aFrom, aTo: Tstrings

Chris

Genau das meine ich. Delphi7 professional meckert da jedenfalls...

sakura 7. Jul 2003 17:04

Re: kompletten Ordner löschen...
 
Ich sehe, in der Erklärung steckt der Wurm ;-)

Danke.
...:cat:...


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:48 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz