30 respuestas en este tema

[monchito_elroro]

Buenas amiguitos, disculpen si los interrumpo en sus labores
pero les quiero pedir un favorcito:

si me pueden ayudar informandome para que sirve y como se usa la
función de buscar archivos "FindFirst" y si fuera posible con un ejemplillo
el más sencillin...... gracias 

[escafandra]

Es igual que en delphi.

FindFirst y FindNext trabajan juntos para navegar por las carpetas y archivos. La ayuda de delphi te puede ser muy útil. Si realizas una búsqueda en el foro encontrarás numerosos ejemplos de uso.

En la ayuda de Lazarus tienes un ejemplo que te cito aquí:

delphi

Program Example43;
 
{ This program demonstrates the FindFirst function }
 
Uses SysUtils;
 
Var Info : TSearchRec;
    Count : Longint;
 
Begin
  Count:=0;
  If FindFirst ('*',faAnyFile and faDirectory,Info)=0 then
    begin
    Repeat
      Inc(Count);
      With Info do
        begin
        If (Attr and faDirectory) = faDirectory then
          Write('Dir : ');
        Writeln (Name:40,Size:15);
        end;
    Until FindNext(info)<>0;
    end;
  FindClose(Info);
  Writeln ('Finished search. Found ',Count,' matches');
 
End.

Saludos.

[monchito_elroro]

Amigo y que vendrían a ser "faAnyFile" y "faDirectory"......... gracias.......

[Delphius]

Amigo y que vendrían a ser "faAnyFile" y "faDirectory"......... gracias.......

Son constantes definidas para los atributos que puede tener un archivo.
Cada constante representa un atributo. Por ejemplo faDirectory hace referencia a que el archivo es un directorio, faAnyFile corresponde a un archivo cualquiera.

Cada constante representa un valor numérico, y se puede varios atributos (y debe, en realidad) combinarse con ands y ors.

Como ha dicho escafandra, ¡lee la ayuda de Delphi que allí está documentado! por favor.

Saludos,

[monchito_elroro]

Amigos aquí yo de nuevo, les cuento mis avances....
resulta que todo lo que me han recomendado me ha ayudado mucho
pero me he cruzado con otro inconveniente y es el siguiente:

De momento estoy practicando con este código para cambiar atributos
recursivamente:

delphi

procedure ChangeAttributes(const path:String);
  var
     search : TSearchRec;
     nFiles : integer;
     cPath : String;
 
  begin
  cpath:=path {GetCurrentDir+'\';};
  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
    SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
    ChangeAttributes(path + search.Name + '\');
    nFiles:=FindNext(Search);
    end;
  //begin
    FindClose(search);
  //end;
  end;

El código es estupendo pero cuando lo ejecuto me sale error:

delphi

unit1.pas(47,26) Error: Identifier not found "setfileattributes"
unit1.pas(47,74) Error: Identifier not found "FILE_ATTRIBUTE_NORMAL"
unit1.pas(52,22) Error: Identifier not found "SetFileAttributes"
unit1.pas(52,71) Error: Identifier not found "FILE_ATTRIBUTE_NORMAL"
unit1.pas(93) Fatal: There were 4 errors compiling module, stopping

Lo cual lo arreglo aumentando la Uses "windows" .....

pero aquí viene otro problema que después de agregar dicha uses cuando está compilando
me lanza otro error que basicamente dice:

delphi

unit1.pas(57,21) Error: Incompatible type for arg no. 1: Got "TSearchRec", expected "QWord"

y me indica que es del comando "FindClose(search);" que he puesto......

ahora..... veo que esto es debido al uses "windows" que he puesto
(sin lo cual los demás comandos no funcionan) pero entonces que debo hacer....

Gracias por la ayuda...

PD: estoy usando Lazarus

[monchito_elroro]

Por favor ayudenme......

[escafandra]

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

Constant    Value    Description
__________________________

faReadOnly    $00000001    Read-only files
faHidden      $00000002    Hidden files
faSysFile      $00000004    System files
faVolumeID    $00000008    Volume ID files
faDirectory    $00000010    Directory files
faArchive    $00000020    Archive files
faAnyFile    $0000003F    Any file

Saludos.

[monchito_elroro]

Buenas amiguitos agradezco sus comentarios y ayuda. Les comento que ya pude realizar mi cometido, y sobre
el problema con el "findclose" resulta que lo que tenía que hacer era o bien
anteponer el USES "windows" al de "sysutils" o sino en vez de poner:

delphi

findclose(search);

tenía que poner:

delphi

SysUtils.FindClose(search);

ahora les enseño el código que estoy usando:

delphi

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  //Classes, windows, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, SysUtils ;
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, windows  ;
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1;
 
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
procedure ChangeAttributes(const path:String);
  var
     search : TSearchRec;
     nFiles : integer;
     cPath : String;
  begin
 
  cpath:=path {GetCurrentDir+'\';};
  nfiles:=findfirst(cpath + '*.*', faanyfile, search);
  if nfiles = 0 then
  begin
    if search.Attr = fadirectory then
    begin
     repeat
      //showmessage(search.Name);    //funciona
      //label1.caption:=search.Name;   //no funca
      if (search.Name<>'.') and (search.Name<>'..') then
      begin
           setfileattributes(Pchar(cpath+search.Name), FILE_ATTRIBUTE_NORMAL);
           ChangeAttributes(path + search.Name + '\');
      end;
      until (FindNext(search) <> 0);
    end
    {else
    SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
    ChangeAttributes(path + search.Name + '\');
 
    nFiles:=FindNext(Search);}
    end;
    SysUtils.FindClose(search);
 
  end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
    ChangeAttributes(GetCurrentDir+'\');
    //label1.Caption:=search.Name;
end;
end.

Con este código puedo realizar mi cometido para cambiar todos los atributos
de todos los archivos (recursivamente) en donde se encuentre mi programa...

A la vez quisiera hacerles una consulta...

como puedo mostrar todos los archivos que procesa en un label, tedit o tmemo

si se fijan bien en una parte de mi código quize hacerlo con:

delphi

label1.caption:=search.Name;

pero no me funciona pues no lo reconoce
a que se deberá.......

espero su ayuda. 

[monchito_elroro]

Holitas amigos, ya pude meter el :

delphi

label1.caption

dentro del

delphi

procedure ChangeAttributes(const path:String);

tenía que poner este último dentro del procedimiento del tbutton.....

lo cual quedaría algo así:

delphi

procedure TForm1.Button1Click(Sender: TObject);
procedure ChangeAttributes(const path:String);
  var
     search : TSearchRec;
     nFiles : integer;
     cPath : String;
  begin
 
  cpath:=path {GetCurrentDir+'\';};
  nfiles:=findfirst(cpath + '*.*', faanyfile, search);
  if nfiles = 0 then
  begin
    if search.Attr = fadirectory then
    begin
     repeat
      label1.caption:=search.Name;  // ahora si se puede usar este código
      if (search.Name<>'.') and (search.Name<>'..') then
      begin
           setfileattributes(Pchar(cpath+search.Name), FILE_ATTRIBUTE_NORMAL);
           ChangeAttributes(path + search.Name + '\');
      end;
      until (FindNext(search) <> 0);
    end
    {else
    SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
    ChangeAttributes(path + search.Name + '\');
 
    nFiles:=FindNext(Search);}
    end;
    SysUtils.FindClose(search);
 
  end;
 
begin
    ChangeAttributes(GetCurrentDir+'\');
    
end;

pero ahora tengo otro problemilla.....
resulta que el código que les mande me trabaja bien pero cuando hay varios archivos el programita se cuelga y sólo cambia los atributos a algunos....

ustedes creen que este bien este código que les puse o no...... gracias

[egostar]

Hola

Intenta cambiando esto:

delphi

if (search.Name<>'.') and (search.Name<>'..')

por esto:

delphi

if (search.Name<>'.') OR (search.Name<>'..')

SaludOS

[monchito_elroro]

Gracias lo intentaré y luego les cuento.... 

[monchito_elroro]

Bueno resulta que intente cambiando:

delphi

if (search.Name<>'.') and (search.Name<>'..') then

por

delphi

if (search.Name<>'.') or (search.Name<>'..') then

pero sigue igual se cuelga el programita, pero sólo en donde hay
muchos archivos (como mi memoria USB).

Pero tratando y tratando he logrado hacerlo funcionar con el siguiente
código:

NOTA: recalco que lo que deseo es que el programita me cambie todos
los atributos de todos los archivos y carpetas recursivamente en donde
lo ejecute.

este es el código:

delphi

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  //Classes, windows, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, SysUtils ;
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, windows, UNIT2  ;
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1;
   //nFiles : integer;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
procedure ChangeAttributes(const path:String);
  var
     search : TSearchRec;
     nFiles : integer;
     cPath : String;
  begin
 
  cpath:=path {GetCurrentDir+'\';};
  nfiles:=findfirst(cpath + '*.*', faanyfile, search);
  while nfiles = 0 do
  //repeat
  begin
    //repeat
    if search.Attr = fadirectory then
    begin
     repeat
      if (search.Name<>'.') and (search.Name<>'..') then
      begin
           setfileattributes(Pchar(cpath+search.Name), FILE_ATTRIBUTE_NORMAL);
           ChangeAttributes(path + search.Name + '\');  //original
 
      end;
      until (FindNext(search) <> 0);
 
    end
    else
    repeat
    SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
    ChangeAttributes(path + search.Name + '\');    //original}
 
    until FindNext(search) <> 0;
     //until FindNext(search) <> 0;
    nFiles:=FindNext(Search);
    end;
    //until FindNext(search) <> 0;
 
    SysUtils.FindClose(search);
 
    {begin
    if  nfiles= then
    form2.Close;
 
    end;}
 
    end;
 
procedure TForm1.Button1Click(Sender: TObject);
 
begin
{Form2 := Tform2.Create(Self);
Form2.Show;}
 
    ChangeAttributes(GetCurrentDir+'\');
 
end;
  //end;
end.

Disculpen si es medio torpe este código pero es lo mejor que puedo hacer
(aparte de que me ha roto la cabeza)....

Espero sus opiniones y comentarios.

PD: Agradezco a escafandra por su código mas lo estoy dejando para el final
pues este que estoy usando lo quiero entender bien primero.

[monchito_elroro]

Buenas les cuento que al código le he implementado un Tmemo
para ver los archivos que procesa, lo adjunto al final y el código es este:

delphi

unit Unit1; 
{$mode objfpc}{$H+}
interface
 
uses
  //Classes, windows, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, SysUtils ;
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, windows, UNIT2  ;
type
 
  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Memo1: TMemo;
    StaticText1: TStaticText;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1;
   //nFiles : integer;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
  procedure ChangeAttributes(const path:String);
      var
         search : TSearchRec;
         nFiles : integer;
         cPath : String;
      begin
      cpath:=path {GetCurrentDir+'\';};
      nfiles:=findfirst(cpath + '*.*', faanyfile, search);
 
      while nfiles = 0 do
      {repeat
      label1.Caption:=search.Name;
      until (FindNext(search) <> 0); }
 
      begin
        if search.Attr = fadirectory then
        begin
         repeat
        memo1.Lines.Add(search.Name);      // FUNCIONA
 
         
          if (search.Name<>'.') and (search.Name<>'..') then
          begin
           
               setfileattributes(Pchar(cpath+search.Name), FILE_ATTRIBUTE_NORMAL);
               ChangeAttributes(path + search.Name + '\');  //original
 
          end;
          until (FindNext(search) <> 0);
          end
 
        else
        repeat
        
        SetFileAttributes(PChar(cPath + search.Name),FILE_ATTRIBUTE_NORMAL);
        ChangeAttributes(path + search.Name + '\');    //original
 
        until FindNext(search) <> 0;
       
        nFiles:=FindNext(Search);
        end;
        SysUtils.FindClose(search);
        
        {begin
        if  nfiles= then
        form2.Close;
        end;}
        end;
 
begin
{Form2 := Tform2.Create(Self);
Form2.Show;}
 
    ChangeAttributes(GetCurrentDir+'\');
end;
end.

A la vez preguntarles porque cuando el programa se ejecuta se pone como
colgado hasta que acabe la operación..... me gustaría saber si se puede hacer
algo para que en vez de colgarse permita ejecutar otro proceso simultaneamente.

gracias. 

[monchito_elroro]

Se me olvidaba  , lo he creado con lazarus x64..... solo funciona en windows de 64bits
mañana les pondré el de 32bits .

[escafandra]

A la vez preguntarles porque cuando el programa se ejecuta se pone como
colgado hasta que acabe la operación..... me gustaría saber si se puede hacer
algo para que en vez de colgarse permita ejecutar otro proceso simultaneamente.

Threads.


Saludos.

[cadetill]

Hombre, escafandra, tampoco hace falta ser "tan drástico" jejeje, no se si en Lazarus existirá el ProcessMessages que hay en Delphi en el objeto Application, pero si lo hay, yo creo que con eso bastaría.

A parte de eso, no entiendo por qué tanto bucle, con un único bucle que pasara por los archivos de la carpeta en curso tendría que ser suficiente, Simplemente mirar si es o no directorio, y si lo es entrar en él recursivamente.

Pongo un ejemplo de código, que no cambia atributos pero borra archivos jejeje

delphi

procedure DeleteTmpFiles(TmpDir, Mask: string);
var
  Search: TSearchRec;
  Files: integer;
begin
  if TmpDir = '' then Exit;
 
  TmpDir := IncludeTrailingPathDelimiter(TmpDir);
 
  Files := FindFirst(TmpDir + Mask, faAnyFile, Search);
  while Files = 0 do
  begin
    if Search.Attr <> faDirectory then
      DeleteFile(TmpDir + Search.Name) 
    else
      if (Search.Name <> '.') and (Search.Name <> '..') then
        DeleteDir(TmpDir + Search.Name);
 
    Files := FindNext(Search);
  end;
  FindClose(Search);
end;

Espero te sirva de orientación

Nos leemos
cadetill

[escafandra]

Hombre, escafandra, tampoco hace falta ser "tan drástico" jejeje, no se si en Lazarus existirá el ProcessMessages que hay en Delphi en el objeto Application, pero si lo hay, yo creo que con eso bastaría.

ProcessMessages existe en Lazarus pero no me gusta. Tratándose de una función recursiva debemos evitar la reentrada a la misma hasta que no termine... Esto obligaría al uso de banderas y el código no queda limpio... Prefiero y son mas seguros los threads.

A parte de eso, no entiendo por qué tanto bucle, con un único bucle que pasara por los archivos de la carpeta en curso tendría que ser suficiente, Simplemente mirar si es o no directorio, y si lo es entrar en él recursivamente.

Totalmente de acuerdo y así se lo sugerí: 

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

Saludos.

[monchito_elroro]

Muchas Gracias por responder, les comento que puse varios bucles por que al principio no me andaba el proceso o simplemente se colgaba, les recalco que soy principiante en lazarus y es por eso que a veces los códigos los realizo hasta donde los entiendo y lo demás los trato de mezclar a la suerte hasta que me funcione uno..... es por eso que puse un "While" con tantos "repeat" porque al principio no me funcionaba el programita........ y ahora al menos realiza lo que deseo.

Voy a probar sus sugerencias....... y les cuento....

PD: que significa:

delphi

IncludeTrailingPathDelimiter

de:

delphi

TmpDir := IncludeTrailingPathDelimiter(TmpDir);

y gracias por recordarme que siempre el código debe estar limpio.

[cadetill]

ProcessMessages existe en Lazarus pero no me gusta. Tratándose de una función recursiva debemos evitar la reentrada a la misma hasta que no termine... Esto obligaría al uso de banderas y el código no queda limpio... Prefiero y son mas seguros los threads.

Bueno, eso se complica más o menos dependiendo desde dónde se ejecute el código. Si por ejemplo se realiza desde un botón, bastaría con deshabilitar ese botón y volverlo a habilitar a su finalización. Pero sí, estoy de acuerdo contigo de que en los procesos recursivos se debería de evitar la reentrada. De echo no me gusta la reentrada en general, puede provocar errores inesperados y mejor evitarla (excepto en funciones recursivas, claro jejejeje).

Referente a tus dudas, monchito_elroro, con un simple vistazo a la ayuda verás que IncludeTrailingPathDelimiter lo único que hace es asegurarte de que un determinado path esté finalizado por el caracter de cambio de directorio, es decir, con el carácter "\" en Windows o "/" en Linux

Imagino que esta función también estará disponible en Lazarus, sino, su implementación es sencilla ;-)

Nos leemos
cadetill

[monchito_elroro]

Gracias cadetill y disculpen por mi ignorancia..... de algo se comienza.....

PD: seguiré al tanto