Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Error al borrar carpetas (https://www.clubdelphi.com/foros/showthread.php?t=88483)

alopete 11-06-2015 14:45:27

Error al borrar carpetas
 
Buenas,

Trabajo con Delphi 2006 y me encuentro con este problema:

Tengo que borrar una carpeta por código con todo su contenido (he probado ya todas las funciones recursivas y demás que he encontrado en foros), pero no lo elimina hasta que cierro la aplicación. No sé si es porque se queda en la memoria o así, pero he comprobado que el current directory es C:\ para asegurarme de que no se queda en algún directorio que ya esté eliminado. El código de la función que tengo ahora es el siguiente:

Código Delphi [-]
function RemoveFolder(const Folder : string): Boolean;
var
  szFile : string;
  SearchRec: TSearchRec;
  szSearchPath : string;
  nResult : integer;
  Attributes: LongWord;
  pname: pchar;
begin
  Result := False;
  szSearchPath := Folder;
  nResult := FindFirst(szSearchPath + '\*.*', faAnyFile, SearchRec);
  try
    while nResult = 0 do
    begin
      if('.' <> SearchRec.Name[1]) then
      begin
        szFile := szSearchPath + '\' + SearchRec.Name;
        FileSetAttr(szFile, 0);
        DeleteFile(PAnsiChar(szFile));
      end;
      nResult := FindNext(SearchRec);
    end;
    Result := True;
  finally
    SysUtils.FindClose(SearchRec);
  end;
  pname := PChar(Folder);
  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);
  Clipboard.close;
  Clipboard.Open;
  if Windows.RemoveDirectory(pname) = False then
    raise EInOutError.Create(SysErrorMessage(GetLastError)); 
end;

Gracias de antemano.

duilioisola 11-06-2015 16:19:14

La función que presentas no es recursiva, por lo que si la carpeta tiene subcarpeta/s no funcionará.
Además de esto, si el archivo empieza por "." tampoco lo borrará. Esto puede darse en algunos casos en de aplicaciones portadas de Linux.

Te dejo a continuación tu función, corregida para ser recursiva y con los pasos comentados para aclarar qué es lo que hace en cada paso.
Verás que he borrado unas lineas que hacen referencia a Clipboard que parece que no tienen relación con el borrado de una carpeta.

Código Delphi [-]
function RemoveFolder(const Folder : string): Boolean;
var
  szFile : string;
  SearchRec: TSearchRec;
  szSearchPath : string;
  nResult : integer;
  Attributes: LongWord;
begin
  Result := False;
  szSearchPath := Folder;

  // Busco el primer archivo dentro de esa carpeta
  nResult := FindFirst(szSearchPath + '\*.*', faAnyFile, SearchRec);
  try
    // Mientras haya archivos...
    while nResult = 0 do
    begin
      // Si el archivo no es uno "especial"
      if not ((SearchRec.Name = '.') or (SearchRec.Name = '..')) then
      begin
        // Obtengo el nombra
        szFile := szSearchPath + '\' + SearchRec.Name;

        // Si es un directorio llamo recursivamente a la funcion
        if ((SearchRec.Attr and faDirectory) = faDirectory) then
           RemoveFolder(szFile)
        else
        begin
           // Si es un archivo lo borro
           FileSetAttr(szFile, 0);
           DeleteFile(PAnsiChar(szFile));
        end;
      end;

      // Busco el siguiente archivo
      nResult := FindNext(SearchRec);
    end;

    // He recorido directorio y subdirectorio correctamente borrandolos
    Result := True;
  finally
    SysUtils.FindClose(SearchRec);
  end;

  // Obtengo atributos de la carpeta
  Attributes := GetFileAttributes(PChar(Folder));

  if (Attributes = $FFFFFFFF) then
    raise EInOutError.Create(SysErrorMessage(GetLastError));

  if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
    SetFileAttributes(PChar(Folder), Attributes and not FILE_ATTRIBUTE_READONLY);

  // Borro la carpeta
  if Windows.RemoveDirectory(PChar(Folder)) = False then
    raise EInOutError.Create(SysErrorMessage(GetLastError));
end;

Nota:
Tengo esta estructura
Código:

  c:\Borrame\Prueba
    A.txt
    B.txt
    Subcarpeta
        C.txt
        D.txt

y lo llamo :
Código Delphi [-]
RemoveFolder('c:\Borrame\Prueba');

alopete 11-06-2015 16:33:04

1 Archivos Adjunto(s)
Hola,

Antes de nada gracias por responder tan rápido.
Lamentablemente, acabo de probarlo y me sigue dando el mismo error:

Archivo Adjunto 3199

He de corregir ante lo dicho, que he probado varias funciones recursivas pero al final he utilizado una que no lo sea puesto que mi estructura es como la siguiente:

Código:

C:\Borrame
    A.txt
    B.txt
    C.pdf

¿Alguna otra sugerencia?
Gracias.

nlsgarcia 11-06-2015 17:04:30

alopete,

Cita:

Empezado por alopete
...Tengo que borrar una carpeta por código con todo su contenido...

:rolleyes:

Revisa esta información:
Espero sea útil :)

Nelson.

ecfisa 11-06-2015 18:02:45

Hola alopete.

Mirando en el buscador de los foros, encontré esto:
Saludos :)

alopete 12-06-2015 10:17:43

Buenos días,

Gracias a todos por vuestras aportaciones.

Ya he probado todo tipo de funciones para borrar la carpeta con su contenido, pero yo creo que el principal problema que tengo es que no se me elimina la carpeta hasta que no cierro la aplicación.

¿Alguna idea de por qué puede suceder?
Muchas gracias.

duilioisola 12-06-2015 11:50:31

Cita:

Empezado por alopete (Mensaje 493257)
Buenos días,

Gracias a todos por vuestras aportaciones.

Ya he probado todo tipo de funciones para borrar la carpeta con su contenido, pero yo creo que el principal problema que tengo es que no se me elimina la carpeta hasta que no cierro la aplicación.

¿Alguna idea de por qué puede suceder?
Muchas gracias.

Quizás tu aplicación está en la capreta que estás borrando...

alopete 12-06-2015 15:36:06

Hola,

He conseguido solventar mi problema. Al final no ha tenido nada que ver con el código: la cuestión era que tenía una pantalla donde añadía los archivos adjuntos con un componente TSheelListView que tenía puesto la propiedad AutoRefresh a True y al intentar eliminar la carpeta de esos adjuntos no me dejaba porque estaba enlazado.

Aún así, muchas gracias a todos!


La franja horaria es GMT +2. Ahora son las 09:38:06.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi