Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #5  
Antiguo 07-02-2006
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.110
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Hola,

Bueno, Román, me gusta más el método que propones, pero, ciertamente en el truco de TrucoMania se hace uso de la recursividad... esto es, se borran los archivos contenidos en un directorio y en los subdirectorios de este. Yo he tratado de llevar a cabo algo similar haciendo uso de lo que propones, que me sigue pareciendo mejor, pero, después de unas cuantas vueltas tengo algo que, si bien parece funcionar (so pena de las revisiones que sean menester), no sé yo si termina siendo "mejor" o "peor" que el truco de TrucoMania...

Código Delphi [-]
uses
  Windows, SysUtils, ShellApi;

function BorrarArchivos(const directorioRaiz, extension: string;
  const borrarRecursivamente, podraDeshacerse: boolean) : boolean;

  function Borrar(const directorios: string) : boolean;
  var
    opciones: Word;
    operacion: TSHFileOpStruct;
  begin
    FillChar(operacion, SizeOf(operacion), #0);
    opciones := FOF_MULTIDESTFILES or
      FOF_NOCONFIRMATION or FOF_SILENT;
    if (podraDeshacerse) then
      opciones := opciones or FOF_ALLOWUNDO;
    operacion.wFunc := FO_DELETE;
    operacion.fFlags := opciones;
    operacion.Wnd := GetDesktopWindow;
    operacion.pFrom := PChar(directorios);
    result := (ShFileOperation(operacion) = 0);
  end;

var
  sDirs: string;
  SR: TSearchRec;
begin
  result := false;
  sDirs := EmptyStr;
  if not DirectoryExists(directorioRaiz) then
    Exit;
  if borrarRecursivamente then
  begin
    sDirs := directorioRaiz +'\*.'+ extension +#0;
    FindFirst(directorioRaiz +'\*.*', faDirectory, SR);
    repeat
      if ((SR.Attr and faDirectory) = faDirectory)
        and (SR.Name <> '.') and (SR.Name <> '..') then
          sDirs := sDirs + directorioRaiz +'\'+ SR.Name +'\*.'+ extension +#0;
    until (SysUtils.FindNext(SR) <> 0);
    SysUtils.FindClose(SR);
    Result := Borrar(sDirs);
  end
  else // Borrar solo archivos del directorio raiz
    Result := Borrar(directorioRaiz +'\*.'+ extension +#0);
end;
Me ha traído un poco de cabeza lo siguiente, puesto que no parece funcionar del todo bien, pero, con esos errores extraños... dice que no encuentra un determinado archivo, que no puede borrarlo, sin embargo, el archivo existe y no sé qué puede pasar. Me explico con lo de error extraño. La función anterior va bien con una carpeta y "dos o tres" subcarpetas con archivos ".tmp". Todo perfecto. Pero si son "diez o doce" carpetas nanai de la china... "No se puede borrar Archivo. No se encuentra el disco..."

Código Delphi [-]
function BorrarArchivos(const directorio, extension:
  string; const podraDeshacerse: boolean) : boolean;

  function Borrar(const dirInt: string) : boolean;
  var
    flags: Word;
    fOp: TSHFileOpStruct;
  begin
    FillChar(fOp, SizeOf(fOp), #0);
    flags := FOF_NOCONFIRMATION or FOF_SILENT;
    with fOp do
    begin
      pTo := nil;
      wFunc := FO_DELETE;
      Wnd := GetDesktopWindow;
      pFrom := PChar(dirInt+'\*.'+extension);
      if (podraDeshacerse) then
        flags := flags or FOF_ALLOWUNDO;
      fFlags := flags;
    end;
    result := (ShFileOperation(fOp) = 0);
  end;

var
  SR: TSearchRec;
begin
  Borrar(directorio);
  FindFirst(directorio+'\*.*', faDirectory, SR);
  repeat
    if ((SR.Attr and faDirectory) = faDirectory)
      and (SR.Name <> '.') and (SR.Name <> '..') then
        Borrar(directorio +'\'+ SR.Name);
  until (FindNext(SR) <> 0);
  SysUtils.FindClose(SR);
end;

Probé con un pequeño "Delay" entre que borraba subcarpeta y subcarpeta, pero, al cabo me quedo con la primera función, que no parece tener problemas con más de 40 carpetas repletas de archivos "*.tmp" conque lo he probado. De todos modos me queda la duda de si será mejor al cabo esta función, insisto, con todos los retoques oportunos, o el truco de TrucoMania, con todos los retoques oportunos también. Bueno. No importa. Me entretuve un rato.
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
borrar archivos d un directorio\subdirectorios segun su extension. No me funciona :( images API de Windows 5 11-06-2007 23:14:30
Borrar y renombrar archivos. zugazua2001 Varios 5 08-07-2005 02:45:44
borrar archivos trabuc Varios 1 17-10-2004 13:36:07
Borrar varios archivos mrmanuel Varios 5 27-05-2004 02:03:54
Borrar archivos de un directorio Magneto Varios 1 13-08-2003 13:20:34


La franja horaria es GMT +2. Ahora son las 06:44:40.


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
Copyright 1996-2007 Club Delphi