Mega Code Archive
Dirdelete
<![CDATA[
> > This afternoon I came across a need I hadn't had before and am
> > perplexed!
> > Is it possible to delete all subdirectories and files under a named
> > directory in D4? Everything I try seems to fail using *.*, but I'm sure
> > there must be a way to accomplish such a common thing!
> >
> > Robert Meek dba TanGentaLs DesiGn
> > E-mail: 'rmeek@ptd.net'
> > ICQ#: '35290775
************************************
To: <Delphi@Kyler.com>
Subject: Re: Re: Deleting Dir's and files
Date sent: Tue, 13 Apr 1999 19:14:03 +0200
Send reply to: Delphi@Kyler.com
Function FOW95(Parent: HWND; Func: UINT; Const sFrom, sTo: String; Flags:
FILEOP_FLAGS; Var UserAborted: Boolean): Boolean;
Var
opLocal: TSHFileOpStruct;
pSemiColon: PChar;
Begin
Result := False;
With opLocal Do Begin
Case Func Of
FO_COPY, FO_MOVE, FO_DELETE, FO_RENAME: Begin
GetMem(pFrom, Length(sFrom) + 2);
Try
StrPCopy(pFrom, sFrom); // den String sFrom nach pFrom kopieren
pFrom[StrLen(pFrom) + 1] := #0; // und mit #0 beenden
pSemiColon := StrScan(pFrom, ';'); // ';' nach #0 konvertieren
While pSemiColon <> Nil Do Begin
pSemiColon[0] := #0;
Inc(pSemiColon);
pSemiColon := StrScan(pSemiColon, ';');
End;
wFunc := Func; // Funktion einfach übergeben, ist In Case
Wnd := Parent; // Window Handle einfach übergeben
pTo := PAnsiChar(sTo); //
fFlags := Flags; // Flags Vom Caller
fAnyOperationsAborted := FALSE; //
hNameMappings := Nil; // Keine Mappings
lpszProgressTitle := Nil; // Kein Titel
Result := Not Bool(SHFileOperation(opLocal)); // Result von
ShellAPI
0=ok,1=Fehler
UserAborted := fAnyOperationsAborted; // ggf Abruch an Caller
Finally
FreeMem(pFrom);
End;
End;
End;
End;
End;
{$IFOPT I+}{$I-}{$DEFINE DeLi}{$ENDIF}
Procedure pKillDir(path: String);
Function fErase(name: String): boolean;
Var
f: File;
Begin
Result := true;
Assign(f, Name);
FileSetAttr(Name, 0);
Try
Erase(f);
Except
On EInOutError Do
Begin
MessageDlg('Killdir: Die Datei ' + Name + 'konnte nicht gelöscht
werden', mtError, [mbOk], 0);
Result := false;
End;
End;
End;
Procedure kill;
Var
sRec: TSearchRec;
found: Integer;
RemDir: boolean;
Begin
found := FindFirst('*.*', faAnyFile, sRec);
Try
While found = 0 Do
Begin
remdir := true;
With sRec Do
Begin
If (Name[1] <> '.') Then
Begin
If (Attr And faDirectory) = faDirectory Then
Begin
ChDir(Name); {-down}
kill;
ChDir('..'); {-up}
If Remdir Then RmDir(Name); {-nur, wenn ferase ohne fehler }
End
Else
Begin
If Not fErase(Name) Then remdir := false;
End;
End; {-Name[1] <> .}
End; {-with sRec}
found := FindNext(sRec);
End; {-While found = 0}
Finally
sysutils.FindClose(sRec);
End;
End; {-Kill}
Begin {-pKillDir}
If DirectoryExists(path) Then
Begin
ChDir(path);
kill;
End; {-DiretoryExists}
End;
Function DelTree(Dir: String): boolean;
Const
cFlags =
FOF_SILENT Or
FOF_NOCONFIRMATION Or
FOF_NOCONFIRMMKDIR Or
FOF_ALLOWUNDO Or
FOF_NOERRORUI;
Var
ab: boolean;
f: integer;
Begin
If Not iswinNT Then Begin
f := cFlags;
Result := FOW95(0, FO_DELETE, Dir, '', F, ab);
End Else
Begin
pKillDir(Dir);
ChDir('..');
rmDir(Dir);
Result := Not DirectoryExists(Dir);
End;
End;
{$IFDEF DeLi}{$I+}{$UNDEF DeLi}{$ENDIF}
> > This afternoon I came across a need I hadn't had before and am
> > perplexed!
> > Is it possible to delete all subdirectories and files under a named
> > directory in D4? Everything I try seems to fail using *.*, but I'm sure
> > there must be a way to accomplish such a common thing!
> >
> > Robert Meek dba TanGentaLs DesiGn
> > E-mail: 'rmeek@ptd.net'
> > ICQ#: '35290775
> >
> >
>
>
> ****************************************************
> If you don't want to see any more of these messages,
> send a message to: MajorDomo@Kyler.com
> with a message of: UNSUBSCRIBE delphi
>
****************************************************
If you don't want to see any more of these messages,
send a message to: MajorDomo@Kyler.com
with a message of: UNSUBSCRIBE delphi
****************************************************
Use recursive procedure. Something like:
procedure DelTree(path : string);
begin
while There_is_a_file_or_a_directory do
begin
if There_is_a_file then Delete(filename);
// this is where the trick is. I call the same proc I am in
// to clear the subdirectory The proc can call itself several
// times in order to delete all subsub an subsubsub directories..
if There_is_a_directory then DelTree(path + '\' + directoryname);
end;
DeleteDirectory(path);
end;
See how it works?
I'm sorry I don't remember all the function names, find them yourself.
****************************************************
There is a cool compontent that's simple to use called DirNav at
hg_soft@uniserve.com. The component has a recursive method that basically
gives you a ride through the user's directories. It could easily be used to
delete files & directories.(And create other mayhem, as well!)
****************************************************
RmDir deletes an empty subdirectory.
procedure RmDir(S: string);
Description
RmDir removes the subdirectory with the path specified by S. If the path
does not exist, is non-empty, or is the currently logged directory, an I/O
error occurs.
**************************************************************************
Deleting a directory and all the directories files
Question:
How can I delete a directory and all the directories files?
[SEE LOWER DOWN -THE DELPHI HELP EXAMPLE IS CLEARER...]
Answer:
The following example demonstrates deleting all the files in a
directory and then the directory itself. Additional processing would
be required to delete read only files and files that are in use.
procedure TForm1.Button1Click(Sender: TObject);
var
DirInfo: TSearchRec; {see below}
r : Integer;
begin
r := FindFirst('C:\Download\Test\*.*', FaAnyfile, DirInfo);
while r = 0 do begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
if DeleteFile(pChar('C:\Download\test\' + DirInfo.Name))
= false then
ShowMessage('Unable to delete : C:\Download\test\' +
DirInfo.Name);
r := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
if RemoveDirectory('C:\Download\Test') = false then
ShowMessage('Unable to delete direcotry : C:\Download\test');
end;
*****************************************************************
SOME USEFUL INFO RE THE ABOVE:
(See Delphi Help for more extensive notes)
*****************************************************************
TSEARCHREC:
TSearchRec = record
Time: Integer;
Size: Integer;
Attr: Integer;
Name: TFileName;
ExcludeAttr: Integer;
FindHandle: THandle;
FindData: TWin32FindData;
end;
And the TSearchRec type defines file information searched for by a FindFirst
or FindNext function call...
*****************************************************************
FINDFIRST:
Declaration
function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;
Description
The FindFirst function allocates resources (memory) which must be released by calling FindClose. FindFirst searches the specified directory for the first entry matching the specified file name and set of attributes.
Note that you can include wildcard characters in the 'Path' string, eg 'c:\test\*.*'
Example
FindFirst is typically used in conjunction with FindNext and FindClose as follows, where ProcessSearchRec represents user-defined code that processes the information in a search record:
begin
Result := FindFirst(Path, Attr, SearchRec);
while Result = 0 do
begin
ProcessSearchRec(SearchRec);
Result := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
*****************************************************************
FINDNEXT:
Declaration
function FindNext(var F: TSearchRec): Integer;
Description
The FindNext function returns the next entry that matches the name and attributes specified in the previous call to the FindFirst function.
*****************************************************************
Unless you're dedicated to writing your own version (as an exercise in
recusion, or the like), try the ShFileOperation API function. It is
automatically recursive. The following procedure is untested:
procedure RecursiveDeletion(const Dir: string);
var
FileOp: TShFileOpStruct;
begin
FileOp.hwnd := 0;
FileOp.wFunc := fo_Delete;
FileOp.pFrom := StrNew(PChar(Dir + #0));
FileOp.pTo := nil;
FileOp.fFlags := fof_NoConfirmation or fof_Silent or fof_NoErrorUI;
ShFileOperation(@FileOp);
StrDispose(FileOp.pFrom);
ShFreeNameMappings(FileOp.hNameMappings);
end;
*****************************************************************
I've written a procedure (D4 on WinNT 4) to delete a specified directory,
along with any files or sub-directories it may contain. The problem is that
it cannot delete the directories, just the files. After tracing through the
code, I found that my call to the RemoveDirectory function returns
ERROR_SHARING_VIOLATION.
procedure RecursiveDeletion (const Dir: string);
var
SR: TSearchRec;
Found: Integer;
begin
Found := FindFirst ( Dir + '\*', faAnyFile, SR );
try
//Iterate through all files / sub-directories found in the specified directory
while Found = 0 do
begin
if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
//Check whether the file located is a sub-directory or not.
//If it is a sub-directory, then call RecusriveDeletion to remove
//any files, or sub-directories it may contain. If it is not a sub-
//directory, set the attributes to FILE_ATTRIBUTE_NORMAL,
//and delete it.
case ( SR.Attr and faDirectory ) > 0 of
true: RecursiveDeletion ( Dir + '\' + Sr.Name );
false:
begin
SetFileAttributes ( PChar( Dir + '\' + SR.Name ), FILE_ATTRIBUTE_NORMAL );
DeleteFile ( PChar ( Dir + '\' + SR.Name ) );
end{false};
end{case};
Found := FindNext ( SR );
end{while};
//Once all sub-directories and files contained by Dir have been
//removed, delete Dir as well.
RemoveDirectory ( PChar ( Dir ) );
finally
SysUtils.FindClose(SR);
end{try};
end;
Has anyone else come across this before, or does anyone have any ideas how
I can get around it?
Is it possibly a problem caused by the recursive calling?
Any help or suggestions would be greatly appreciated.
Ben O'Keeffe
]]>