Lenguaje de programación Borland Delphi
El programa de línea de comando DELTREE.EXE que viene con Windows elimina un directorio con todos sus archivos y subdirectorios. Para imitar este comportamiento en Delphi podemos usar el siguiente procedimiento que usa las funciones FindFirst, FindNext y FindClose para realizar la búsqueda de archivos y directorios:
uses SysUtils, Windows;
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);
// Borrar recursivamente todos los archivos y directorios
// dentro del directorio que se pasa como parámetro.
var
SearchRec: TSearchRec;
Attributes: LongWord;
ShortName, FullName: TFileName;
pname: pchar;
begin
if FindFirst(Directory + '*', faAnyFile and not faVolumeID,
SearchRec) = 0 then begin
try
repeat // Procesa todos los archivos y directorios
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
// Es un directorio
if (ShortName <> '.') and (ShortName <> '..') then
rDelTree(FullName + '');
end else begin
// Es un archivo
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
// Si no es un directorio raíz, lo remueve
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;
Llamadas de ejemplo 1: Este código eliminará el directorio C:\TEMPA123:
DelTree('C:TEMPA123');
Y este código "limpiará" el diskette en la unidad A:
DelTree('A:');
Publicado el: 2003-10-05