10 respuestas en este tema

[monchito_elroro]

Buenas con todos, yo aquí después de un tiempito vengo con una pequeña consulta, resulta que últimamente estoy teniendo problema con un bucle, el cual en ciertos momentos funciona bien y en otros no, quizas ya mucho de ustedes habrán visto el código que utilizo, lo postee hace un tiempo cuando tenía otro problema...  lo utilizo para cambiar atributos en forma recursiva o sino para listar archivos y carpetas recursivamente.

el código como muchos sabrán es:

delphi

procedure TForm1.Button1Click(Sender: TObject);
  procedure ChangeAttributes(const path:String);
  var
    search : TSearchRec;
    nFiles : integer;
    cPath : String;
  begin
    application.ProcessMessages;    // ESTE HACE QUE NO SE CUELGUE EL PROGRAMITA... JEEEEE
    cpath:=path {GetCurrentDir+'\';};
    //cpath:=letra+'\';
 
    nfiles:=findfirst(cpath + '*.*', faanyfile, search);
 
    while nfiles = 0 do
    begin
      if search.Attr = fadirectory then
      begin
        if (search.Name<>'.') and (search.Name<>'..') then
        begin
          setfileattributes(Pchar(cpath+search.Name), FILE_ATTRIBUTE_NORMAL);
          ChangeAttributes(path + search.Name + '\');
          //memo1.Lines.Add(cPath+search.Name);
        end;
      end
      else
      begin
        SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
        ChangeAttributes(path + search.Name + '\');
        memo1.Lines.Add(cPath+search.Name);
      end;
      nFiles:=FindNext(Search);
    end;
    SysUtils.FindClose(search);
  end;
begin
  ChangeAttributes(GetCurrentDir+'\'); // esta es su llamada
end;

Debo aclarar que el código trabaja bien casi todo el tiempo, pero por momentos como que se vuelve loco y no para de dar vueltas y vueltas de forma infinita....

Ahora para poder ver lo que está procesando he colocado un "tmemo" para poder registrar todo lo que se procesa (archivos y carpetas) y me he dado con la sorpresa que en los momentos que se vuelve loco sale esto en el memo:

Ejemplo:

D:\trabajos\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\.\


lo cual me deja más intrigado....   
He probado varias veces buscando la causa y una pista que pude encontrar es que este problema también ocurre cuando un archivo o carpeta esta "comprimida para ahorrar espacio" el cual es una característica de windows para NTFS...

Agradezco a cualquiera que me de una mano y saber si a alguien más le ha pasado esto, también les adjunto un ejemplo con el error presente.


PD: la carpeta con el error se llama "prueba" y tienen que "comprimirlo para ahorrar espacio" ahí
verán el error.

Archivos adjuntos

•  3802_c1ae7f0e29117cb609cc8e5560bfeb55c7239545.zip   896,13KB   0 descargas

[cadetill]

Buenas,

Intenta indentar bien el código, es muy complicado de leer si no lo está

[cadetill]

Buenas,

Una vez indentado, veamos.....

A simple vista (y sin probar el código), a mi me sobraría la línea "ChangeAttributes(path + search.Name + '\');" cuando el fichero NO es un directorio. No tiene sentido hacer esa llamada recursiva (que sí lo tiene en el caso de los directorios).

Nos leemos

[escafandra]

Como te ha indicado cadetill el código está mal diseñado No debe reentrar en el caso de archivos y es por esa razón por la que tienes el problema del "bucle infinito"

Hace tiempo publiqué una función recursiva y de uso general para cambiar atributos, ¿recuerdas?:

Aquí te respondí a esta misma cuestión. ¿Recuerdas?

Te la vuelvo a copiar:

delphi

procedure SetAttribute(Path: String; dwFileAttributes: DWORD; SubDir: boolean = false);
var
  A:  integer;
  sr: TSearchRec ;
  FileName, Dir: String;
begin
  A:= FileSetAttr(PCHAR(Path), dwFileAttributes);
  Dir:= ExtractFileDir(Path) + '\';
  FileName:= ExtractFileName(Path);
  if FileName = '' then FileName:= '*.*';
  if (Dir <> '') and (FindFirst(Dir + FileName, faAnyFile, sr) = 0) then
  repeat
    if (sr.Name <> '.') and (sr.Name <> '..') then
    begin
      A:= FileSetAttr(PCHAR(Dir + sr.Name), dwFileAttributes);
      if (sr.Attr and faDirectory) <> 0  then
        if SubDir then SetAttribute(Dir + sr.Name + '\', dwFileAttributes, true);
    end;
  until (FindNext(sr) <> 0);
  FindClose(sr);
end;

Para tu propósito el uso sería así:

delphi

SetAttribute(GetCurrentDir+'\', FILE_ATTRIBUTE_NORMAL, true);

Como detalle diferencial, la que yo publico usa la función FileSetAttr y la tuya la API de Windows SetFileAttributes. Pues bien, tratándose de Lazarus es mejor no usar la API de Windows y usar FileSetAttr por compatibilidad con otras plataformas.


Saludos.

[monchito_elroro]

Gracias por su pronta ayuda amigos, intentaré lo que me están sugeriendo.....

También quiero preguntarle al amigo Escafranda si utilizo su código para poder cambiar los atributos de todos los archivos y carpetas su llamada estaría bien si lo uso así:

delphi

SetAttribute(GetCurrentDir+'\', FILE_ATTRIBUTE_NORMAL, true);

ó así:

delphi

SetAttribute(GetCurrentDir+'\', faArchive, true);

Saludos...

PD: que significa "dwFileAttributes"

[cadetill]

PD: que significa "dwFileAttributes"

No significa nada, es sólo el nombre de una variable

Y a la primera pregunta, la primera opción es la buena

Nos leemos

[monchito_elroro]

Gracias por la aclaración  ......  les cuento que hice lo que me recomendaron, elimine la parte de:

delphi

ChangeAttributes(path + search.Name + '\');

En donde procesaba archivos ........ y ahora funciona bien, no se traba, pero al momento de cambiar atributos solo lo hace a los archivos de la raiz mas no hay recursión... 

Estoy pensando utilizar el código del amigo Escafranda.... seguiré probando y les cuento. 

[escafandra]

No debes eliminar todas las líneas, sólo cuando NO es un directorio. En los directorios SI debe haber recursividad.


Saludos.

[monchito_elroro]

Hola amigo escafranda, justo he hecho lo que me han sugerido solo donde se procesa los archivos y sucede lo que les puse arriba, procesa todo pero no recursivamente, les pongo como lo hice:

delphi

procedure TForm1.Button1Click(Sender: TObject);
  procedure ChangeAttributes(const path:String);
       var
          search : TSearchRec;
          nFiles : integer;
          cPath : String;
       begin
       application.ProcessMessages;  
       cpath:=path;
      
       nfiles:=findfirst(cpath + '*.*', faanyfile, search);
       while nfiles = 0 do
       begin
         if search.Attr = fadirectory then
         begin
         if (search.Name<>'.') and (search.Name<>'..') then
 
         begin
         setfileattributes(Pchar(cpath+search.Name), FILE_ATTRIBUTE_NORMAL);
         ChangeAttributes(path + search.Name + '\');
         end;
         end
         else
         begin
         SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
         //ChangeAttributes(path + search.Name + '\');  // ACA LO DESHABILITE
         memo1.Lines.Add(cPath+search.Name);
         end;
         nFiles:=FindNext(Search);
         end;
         SysUtils.FindClose(search);
         End;
 
begin
  ChangeAttributes(GetCurrentDir+'\'); // esta es su llamada
end;

Les pido una manito .... 

[escafandra]

Dos cosas:

1. Indenta correctamente el código.
2. Estás mirando mal los atributos de Directorio.

Cambia la línea:

delphi

if  search.Attr = fadirectory then

por

delphi

if (search.Attr and fadirectory) <> 0 then

Los atributos son valores de bit "acumulativos"



Saludos.

[monchito_elroro]

Lo acabo de probar y ahora si agarra.... gracias amigo escafranda  .