Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Nick


Contraseña


Nuevo usuario


English
Imitar el comando Deltree - eliminar carpetas y subcarpetas completas - Delphi
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

Este sitio web NO CONTIENE malware, todos los programas con código fuente aquí. Autor: Alonso Javier Pérez Díaz Google+ Síguenos en Google+