Consulta con FindFirst
#1
Posted 22 October 2011 - 12:28 PM
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
#2
Posted 23 October 2011 - 06:31 AM
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.
#3
Posted 23 October 2011 - 10:00 AM
#4
Posted 23 October 2011 - 12:19 PM
Son constantes definidas para los atributos que puede tener un archivo.Amigo y que vendrían a ser "faAnyFile" y "faDirectory"......... gracias.......
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,
#5
Posted 24 October 2011 - 12:43 PM
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:
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:
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:
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
#6
Posted 24 October 2011 - 07:43 PM
#7
Posted 25 October 2011 - 12:19 AM
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.
#8
Posted 25 October 2011 - 06:31 PM
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:
findclose(search);
tenía que poner:
SysUtils.FindClose(search);
ahora les enseño el código que estoy usando:
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:
label1.caption:=search.Name;
pero no me funciona pues no lo reconoce
a que se deberá.......
espero su ayuda.
#9
Posted 27 October 2011 - 07:09 PM
label1.caption
dentro del
procedure ChangeAttributes(const path:String);
tenía que poner este último dentro del procedimiento del tbutton.....
lo cual quedaría algo así:
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
#10
Posted 27 October 2011 - 09:17 PM
Intenta cambiando esto:
if (search.Name<>'.') and (search.Name<>'..')
por esto:
if (search.Name<>'.') OR (search.Name<>'..')
SaludOS
#11
Posted 28 October 2011 - 07:34 AM
#12
Posted 28 October 2011 - 12:36 PM
if (search.Name<>'.') and (search.Name<>'..') then
por
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:
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.
#13
Posted 28 October 2011 - 07:08 PM
para ver los archivos que procesa, lo adjunto al final y el código es este:
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.
#14
Posted 28 October 2011 - 07:12 PM
mañana les pondré el de 32bits .
#16
Posted 01 November 2011 - 02:34 AM
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
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
#17
Posted 01 November 2011 - 03:26 AM
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.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.
Totalmente de acuerdo y así se lo sugerí:
Aquí te respondí a esta misma cuestión. ¿Recuerdas?
Saludos.
#18
Posted 01 November 2011 - 10:47 AM
Voy a probar sus sugerencias....... y les cuento....
PD: que significa:
IncludeTrailingPathDelimiter
de:
TmpDir := IncludeTrailingPathDelimiter(TmpDir);
y gracias por recordarme que siempre el código debe estar limpio.
#19
Posted 01 November 2011 - 12:39 PM
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
#20
Posted 01 November 2011 - 09:54 PM
PD: seguiré al tanto