29 respuestas en este tema

[enecumene]

Hola amigos, ando buscando un código donde busque archivos en carpetas y sub-carpetas mediante filtros, me explico, selecciono una carpeta y quiero que me busque dentro de ella archivos .Mp3, .Wma y .Mp4 y también sus subcarpetas, el objetivo es que al seleccionar una carpeta me vaya agregando en un DBGrid u otro componente similar y leer los IDv3 mientras la agrega, ya esa parte me encargo, ¿alguien conoce algún código de ese tipo?.

Saludos.

[enecumene]

Bueno, tengo lo siguiente, lo hice de memoria era un codigo que me facilitaron hace un tiempo y no lo encontraba, le agregué unas cuantas cosas para mi objetivo, lo logré, en este caso usé un ComboBox:

delphi

procedure TForm1.Button1Click(Sender: TObject);
var
  TS:TStrings;
  i:Integer;
 
 
  procedure ArchivosDirectorio(dir, mascara: string;
    var lista: TStrings; const soloNombres: boolean);
  var
    SR: TSearchRec;
  begin
    dir := IncludeTrailingPathDelimiter(dir);
    if FindFirst(dir + mascara, faAnyFile, SR) = 0 then
    begin
      repeat
        if not soloNombres then
          lista.Add(ExtractFileName(ChangeFileExt(dir + SR.Name, '')))
        else
          lista.Add(dir + SR.Name);
      until FindNext(SR) <> 0;
      SysUtils.FindClose(SR);
    end;
  end;
 
begin
 
Carpeta.Execute;
 
if Carpeta.Directory <> '' then
  begin
  TS := TStringList.Create();
  try
    ArchivosDirectorio(Carpeta.Directory, '*.pas', TS, True);
 
    for i := 0 to (TS.Count - 1) do begin
      TS.Strings[i] := ExtractFileName(TS.Strings[i]);
    end;
 
 
    ComboBox1.Items.Clear;
    ComboBox1.Items.AddStrings(TS);
    ComboBox1.ItemIndex := 0;
 
  finally
    FreeAndNil(TS);
  end;
 end;
end;

Dos cosas:

1) Necesito lograr agregar más formatos, o sea, que sea multiformato.
2) Que me lea las sub-carpetas, no logro conseguirlo.

Saludos.

[enecumene]

Vamos chicos, ¿nadie me puede ayudar con este asunto?

Saludos.

[Delphius]

Hola amigo, JM en su sitio habló de un componente que él hizo que sirve para buscar archivos. Puede trabajar con uno o varios formatos, además explora las subcarpetas. El componente se llama TBuscador.

El problema está en que el sitio de JM actualmente está fuera de servicio . Ya me fijo si es que todavía lo tengo. Sino será cuestión de buscar si está disponible la descarga de dicho componente en algún otro sitio o alguno otro parecido.

Por lo que veo en dicho código, tal vez se pueda modificar el parametro mascara para que sea un TStrings y valerse de éste TStrings para recorrer todos sus items cuando se lo compara en el FindFirst(). La idea que se me ocurre es que pasamos la lista con todos los formatos.

Algo así:

delphi

procedure ArchivosDirectorio(dir, mascaras: TStrings; var lista: TStrings; const soloNombres: boolean);

Y en la parte de la comparación en el FindFirst hacer algo como esto:

delphi

for i := 0 to mascaras.Count - 1 do
  if FindFirst(dir + mascaras[i], faAnyFile, SR) = 0 then ...

Como hacer para buscar en subcarpetas ya me tengo que poner a repasar bien esto. Disculpa.

Saludos,
 

[seoane]

La busqueda en subdirectorios es un ejemplo tipico de funcion recursiva.

Por ejemplo:

delphi

procedure Buscar(Lista: TStringList; Path, Mascara: String); overload;
var
  SR: TSearchRec;
begin
  Path:= IncludeTrailingPathDelimiter(Path);
  if FindFirst(Path + '*.*', faAnyfile, SR) = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) = faDirectory then
        Buscar(Lista,Path+SR.Name,Mascara);
  until FindNext(SR) <> 0;
  FindClose(SR);
  if FindFirst(Path + Mascara, faAnyfile, SR) = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) <> faDirectory then
        Lista.Add(Path + SR.Name);
  until FindNext(SR) <> 0;
  FindClose(SR);
end;
 
// Ejemplo de uso
var
  Lista: TStringList;
begin
  Lista:= TStringList.Create;
  try
    Buscar(Lista,'c:\windows\web','*.jpg');
    ShowMessage(Lista.Text);
  finally
    Lista.Free;
  end;
end;

Y si tenemos mas de una mascara solo se me ocurre buscar varias veces:

delphi

procedure Buscar(Lista: TStringList; Path, Mascara: String); overload;
var
  SR: TSearchRec;
begin
  Path:= IncludeTrailingPathDelimiter(Path);
  if FindFirst(Path + '*.*', faAnyfile, SR) = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) = faDirectory then
        Buscar(Lista,Path+SR.Name,Mascara);
  until FindNext(SR) <> 0;
  FindClose(SR);
  if FindFirst(Path + Mascara, faAnyfile, SR) = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) <> faDirectory then
        Lista.Add(Path + SR.Name);
  until FindNext(SR) <> 0;
  FindClose(SR);
end;
 
procedure Buscar(Lista: TStringList; Path: String; Mascaras: TStringList); overload;
var
  i: Integer;
begin
  for i:= 0 to Mascaras.Count - 1 do
    Buscar(Lista,Path,Mascaras[i]);
end;
 
// Ejemplo de uso
procedure TForm1.Button1Click(Sender: TObject);
var
  Lista: TStringList;
  Mascaras: TStringList;
begin
  Lista:= TStringList.Create;
  try
    Mascaras:= TStringList.Create;
    try
      Mascaras.Add('*.jpg');
      Mascaras.Add('*.bmp');
      Buscar(Lista,'c:\windows\web',Mascaras);
    finally
      Mascaras.Free;
    end;
    ShowMessage(Lista.Text);
  finally
    Lista.Free;
  end;
end;

[Delphius]

Bueno Fernando, encontré entre mis cosas la carpeta donde tengo los archivos del componente. Lo zipié , hago para adjuntarlo, quiero publicar el mensaje y no me deja.
Me dice que hubo un error al intentar adjuntar el archivo. Pensé que era el tamaño pero son 20K.

Saludos,

[enecumene]

mmmm, eso está raro amigo, déjame revisar eso, seoane, haré la prueba de tu código, luego te comento.

Saludos.

[Delphius]

La busqueda en subdirectorios es un ejemplo tipico de funcion recursiva.


Y si tenemos mas de una mascara solo se me ocurre buscar varias veces:

delphi

procedure Buscar(Lista: TStringList; Path, Mascara: String); overload;
var
  SR: TSearchRec;
begin
  Path:= IncludeTrailingPathDelimiter(Path);
  if FindFirst(Path + '*.*', faAnyfile, SR) = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) = faDirectory then
        Buscar(Lista,Path+SR.Name,Mascara);
  until FindNext(SR) <> 0;
  FindClose(SR);
  [b]if FindFirst(Path + Mascara, faAnyfile, SR)[/b] = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) <> faDirectory then
        Lista.Add(Path + SR.Name);
  until FindNext(SR) <> 0;
  FindClose(SR);
end;
 
procedure Buscar(Lista: TStringList; Path: String; Mascaras: TStringList); overload;
var
  i: Integer;
begin
  for i:= 0 to Mascaras.Count - 1 do
    Buscar(Lista,Path,Mascaras[i]);
end;
 
// Ejemplo de uso
procedure TForm1.Button1Click(Sender: TObject);
var
  Lista: TStringList;
  Mascaras: TStringList;
begin
  Lista:= TStringList.Create;
  try
    Mascaras:= TStringList.Create;
    try
      Mascaras.Add('*.jpg');
      Mascaras.Add('*.bmp');
      Buscar(Lista,'c:\windows\web',Mascaras);
    finally
      Mascaras.Free;
    end;
    ShowMessage(Lista.Text);
  finally
    Lista.Free;
  end;
end;

Hola Domingo no he probado el código, pero ¿no se puede evitar lanzar múltiples búsquedas y directamente poner el for antes del FinFirst? Algo como lo que decía unos post antes:

delphi

for i := 0 to mascaras.Count - 1 do
  if FindFirst(Path + mascaras[i] ...

Contra un:

delphi

for i := 0 to mascaras.Count - 1 do
  Buscar(....)

Nomás es una duda que me asalta.

Saludos,

[seoane]

Pues claro Delphius, eso seria mucho mas eficiente:

delphi

procedure Buscar(Lista: TStringList; Path: String; Mascaras: TStringList);
var
  i: Integer;
  SR: TSearchRec;
begin
  Path:= IncludeTrailingPathDelimiter(Path);
  if FindFirst(Path + '*.*', faAnyfile, SR) = 0 then
  repeat
    if (SR.Name <>  '.') and (SR.Name <> '..') then
      if (SR.Attr and faDirectory) = faDirectory then
        Buscar(Lista,Path+SR.Name,Mascaras);
  until FindNext(SR) <> 0;
  FindClose(SR);
  for i:= 0 to Mascaras.Count - 1 do
  begin
    if FindFirst(Path + Mascaras[i], faAnyfile, SR) = 0 then
    repeat
      if (SR.Name <>  '.') and (SR.Name <> '..') then
        if (SR.Attr and faDirectory) <> faDirectory then
          Lista.Add(Path + SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

[cHackAll]

Aunque es una solucion totalmente aceptable, dare MIs dos puntos en contra del anterior codigo;

• Aunque la informacion haya sido almacenada en caché, el segundo listado (bucle FindFirst) produce un numero de llamadas "duplicadas"
• Usar una clase TStringsList como máscara amerita manejo de datos y de la clase en si

Aunque prefiero no usar "concatenación" de cadenas y metodos SysUtils, dejo e siguiente código por ser mas comprensible.

delphi

procedure TForm1.Process(Path: string; const Mask: string);
var sr: TSearchRec;
begin
 Path := Path + PathDelim;
 if FindFirst(Path + '*.*', faAnyFile, sr) = 0 then
  begin
   repeat
    if (sr.Attr and faDirectory) <> 0 then
     if (sr.Name <> '.') and (sr.Name <> '..') then
      Process(Path + sr.Name, Mask)
     else
    else
     if Pos(ExtractFileExt(sr.Name) + '.', '.' + Mask + '.') > 1 then
      ListBox1.AddItem(Path + sr.Name, nil);
   until FindNext(sr) <> 0;
   FindClose(sr);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 Process('c:', '.exe.com.dll.sys');
end;

Saludos

[seoane]

Ya había pensado en esa solución chackall, pero y si queremos usar una mascara como esta "uno*.jp*"

[Caral]

Hola
Esto se pone bueno, duelo de titanes.
Saludos

[enecumene]

Hace tiempo habí­a probado con el code que propuso mi estimado ChackAll en el post #9 y me ha funcionado perfecto, pero hay un asunto y es que deja un efecto no muy agradable y es que mientras se realiza la búsqueda el aplicativo aparenta estar congelado y no puedo moverla o minimizarla, he usado el Busy de ChackAll pero aún no puedo minimizarlo o mover el formulario, ¿hay alguna otra manera de resolver ese problema?.

Saludos.

[enecumene]

Estoy teniendo problemas con el code con unos agregados que he hecho, queda así­:

delphi

procedure TForm1.Process(Path: string; const Mask: string);
var sr: TSearchRec;
    Artista, Album, Titulo, Ano, Calidad, Genero, Comentario: String;
begin
 Path := Path + PathDelim;
 if FindFirst(Path + '*.*', faAnyFile, sr) = 0 then
  begin
   repeat
    if (sr.Attr and faDirectory) <> 0 then
     if (sr.Name <> '.') and (sr.Name <> '..') then
      Process(Path + sr.Name, Mask)
     else
    else
     if Pos(ExtractFileExt(sr.Name) + '.', '.' + Mask + '.') > 1 then
      ObtenerID3Tag((path + sr.Name),Titulo,Artista,Album,Ano,Genero,Comentario);
     if cdsCanciones.Active = False then
       cdsCanciones.Open;
     {*** registramos en el XML ***}  
      cdsCanciones.Append;
      cdsCanciones.FieldByName('ID').AsInteger      := cdsCanciones.RecordCount + 1;
      cdsCanciones.FieldByName('Artista').AsString  := Artista;
      if Titulo <> '' then
      cdsCanciones.FieldByName('Titulo').AsString   := Titulo
      else
      cdsCanciones.FieldByName('Titulo').AsString   := sr.Name;
      
      cdsCanciones.FieldByName('Album').AsString    := Ano;
      cdsCanciones.FieldByName('Genero').AsString   := Genero;
      cdsCanciones.FieldByName('Ano').AsInteger     := StrToIntDef(Album,0);
      cdsCanciones.FieldByName('Calidad').AsInteger := StrToIntDef(Calidad,0);
      cdsCanciones.FieldByName('Ruta').AsString     := Path + sr.Name;
      cdsCanciones.Post;
   until FindNext(sr) <> 0;
   FindClose(sr);
  end;
end;

Y lo ejecuto con una sola Máscaras así­:

delphi

procedure TForm1.Button1Click(Sender: TObject);
begin
 Process('C:', '.mp3');
end;

Pero me busca todos los archivos sin importar la(s) máscara(s), a ver, ¿qué estoy haciendo mal? .

Saludos.

PD. Anexo una imagen del resultado.

[egostar]

Hola

Y no será por esto ????

delphi

if FindFirst(Path + '*.*', faAnyFile, sr) = 0 then

No deberia ser:

delphi

if FindFirst(Path + '*'+Mask, faAnyFile, sr) = 0 then

Salud OS

[Delphius]

Ups... veo que no habí­a subido el componente ...

El componente al que me referí­a es el que adjunto. Pertenece a JM (Juan Manuel), un desarrollador español.
Hace tiempo que no volví­a a pasearme por la web de JM... acabo de darme un paseo y me doy con que expiró . Era un sitio estupendo.

No se hasta que punto es "legal".


Saludos,

Archivos adjuntos

•  597_5ab3da95892a79d74debce81a8c1f6d580ebc15c.zip   19,64KB   29 descargas

[cHackAll]

Hace tiempo habí­a probado con el code que propuso mi estimado ChackAll en el post #9 y me ha funcionado perfecto, pero hay un asunto y es que deja un efecto no muy agradable y es que mientras se realiza la búsqueda el aplicativo aparenta estar congelado y no puedo moverla o minimizarla, he usado el Busy de ChackAll pero aún no puedo minimizarlo o mover el formulario, ¿hay alguna otra manera de resolver ese problema?...

En éste caso la respuesta más acertada es separar el algoritmo de búsqueda de la interfaz (dejando a un lado la unidad Busy para otros casos más especí­ficos). Mientras la velocidad del hilo estará dada por la velocidad de acceso a la información en el medio de almacenamiento, podremos mostrar una animación a una velocidad constante y distinta de la primera.

Para no enredarnos con clases y para facilitar lo anteriormente dicho utilizaremos la API CreateThread adaptando el procedimiento Process (ahora Search);

delphi

var
 Path: array [0..MAX_PATH] of Char; // {MAX_PATH + 1} para asegurar que el último carácter sea #0
 FindFileData: TWin32FindData; // es global para disminuir el “proceso en pila”
 
procedure Search(const lpString: PChar); stdcall; // hilo recursivo
var
 len, hFindHandle: Cardinal;
 lpFileName, lpExt: PChar;
begin
 len := lstrlen(@Path) + 1; // solo usaremos una variable de 32 bits para manejar las rutas
 hFindHandle := FindFirstFile(lstrcat(@Path, '\*.*'), FindFileData); // concatenamos e iniciamos la “busqueda”
 if hFindHandle <> INVALID_HANDLE_VALUE then
  begin
   repeat lpFileName := @FindFileData.cFileName; lstrcpy(@Path[len], lpFileName); // concatenamos la ruta con el nombre del archivo
    if (FindFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then // si es una carpeta
     if (PWord(lpFileName)^ <> Ord('.')) and (PWord(@lpFileName[1])^ <> Ord('.')) then // “procesable” entonces
      Search(lpString) // la procesamos.
     else
    else
     begin
      lpExt := lpFileName; 
      while lpFileName[0] <> #0 do
       begin
        if lpFileName[0] = '.' then
         lpExt := lpFileName; // extraemos la extensión del archivo
        Inc(lpFileName);
       end;
      PWord(lpFileName)^ := Ord('.'); // le “aumentamos” un punto al final para delimitar su búsqueda (Ej. '.exe.')
      if Assigned(strstr(lpString, _strlwr(lpExt))) then // y buscamos dicha extensión en la “lista”
       Form1.ListBox1.AddItem(Path, nil); // agregamos dicha ocurrencia a la lista de archivos
     end;
   until not FindNextFile(hFindHandle, FindFileData);
   Windows.FindClose(hFindHandle);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 ListBox1.Clear; // limpiamos la lista
 lstrcpy(@Path, 'c:'); // e inicializamos la ruta de búsqueda, la cual es global para acceder desde “fuera del hilo”.
// Finalmente creamos el hilo el cual al ser un procedimiento se llamará recursivamente. El parámetro ha de ser
// la “lista” de extensiones a buscar con un punto extra al final. Timer1.Tag es definido con el identificador del hilo
// para que él mismo “sepa” cuando el hilo ha terminado la búsqueda.
 Timer1.Tag := CreateThread(nil, 0{}, @Search, PChar('.dll.exe.sys.bat.vbs.cmd.com.'), 0, PDWORD(0)^);
 Button1.Visible := False; // ocultamos el botón para que no sea llamado dos veces
 Timer1.Enabled := True; // e iniciamos el Timer1 para mostrar algún tipo de animación y que al finalizar el mismo “reactive” el botón.
end;

En el adjunto está el código completo y un ejemplo sencillo de “animación”, incluyendo la finalizacion del hilo en caso de cerrarse la aplicación.

 

...Y lo ejecuto con una sola Máscaras así­:

delphi

procedure TForm1.Button1Click(Sender: TObject);
begin
 Process('C:', '.mp3');
end;

Pero me busca todos los archivos sin importar la(s) máscara(s), a ver, ¿qué estoy haciendo mal? ...

Se te esta olvidando un begin y end en cuando la extensión es reconocida; este olvido esta provocando que todos los archivos y carpetas sean procesados en el XML;

delphi

procedure TForm1.Process(Path: string; const Mask: string);
var sr: TSearchRec; Artista, Album, Titulo, Ano, Calidad, Genero, Comentario: string;
begin
 Path := Path + PathDelim;
 if FindFirst(Path + '*.*', faAnyFile, sr) = 0 then
  begin
   repeat
    if (sr.Attr and faDirectory) <> 0 then
     if (sr.Name <> '.') and (sr.Name <> '..') then
      Process(Path + sr.Name, Mask)
     else
    else
     if Pos(ExtractFileExt(sr.Name) + '.', '.' + Mask + '.') > 1 then
      begin // ESTE !!!
       ObtenerID3Tag((path + sr.Name),Titulo,Artista,Album,Ano,Genero,Comentario);
       if cdsCanciones.Active = False then
        cdsCanciones.Open;
       {*** registramos en el XML ***}  
       cdsCanciones.Append;
       cdsCanciones.FieldByName('ID').AsInteger      := cdsCanciones.RecordCount + 1;
       cdsCanciones.FieldByName('Artista').AsString  := Artista;
       if Titulo <> '' then
        cdsCanciones.FieldByName('Titulo').AsString   := Titulo
       else
        cdsCanciones.FieldByName('Titulo').AsString   := sr.Name;
       cdsCanciones.FieldByName('Album').AsString    := Ano;
       cdsCanciones.FieldByName('Genero').AsString   := Genero;
       cdsCanciones.FieldByName('Ano').AsInteger     := StrToIntDef(Album, 0);
       cdsCanciones.FieldByName('Calidad').AsInteger := StrToIntDef(Calidad, 0);
       cdsCanciones.FieldByName('Ruta').AsString     := Path + sr.Name;
       cdsCanciones.Post;
      end; // ESTE!!!
    until FindNext(sr) <> 0;
   FindClose(sr);
  end;
end;

Salud!

[rgstuamigo]

Yo no se por que tanto se complican  ,sabiendo que delphi ya posee componentes para tal
Amigo Enecumene, has lo siguiente:
1.-Arrastrate un TFileListBox(pestaña Win3.1 de la paleta de componente)
2.-Pon en su propiedad Mask la mascara  por ejemplo C:\Mi\Ruta\Completa\*.MP3  y listo ya tiene listado todos los archivos en el FileListBox y sin codificar nada, por supueto que este componente utiliza las funciones FindFirst y FindNext internamente.
Saludos...

[cHackAll]

Yo no se por que tanto se complican  ,sabiendo que delphi ya posee componentes para tal ...

Aunque la respuesta corta serí­a que nos gusta quemar neuronas en vano, la respuesta larga esta relacionada con recursividad; mientras que el descrito inicialmente nos retornará una lista con todos los archivos que concuerden con una lista extensiones en una ruta determinada y todas sus subcarpetas, tu solución solo retornara la ocurrencia de una mascara en una carpeta (y no así­ de las carpetas que estén dentro de ésta) ver siguiente ejemplo sin componentes;

delphi

ListBox1.Perform(LB_DIR, DDL_ARCHIVE, Integer(PChar('c:\windows\system32\*.dll')));

[alquimista]

En delphiarea.com hay un componente gratuito FindFile que es una pasada..
Trabaja con filtros de todo tipo y se puede utilizar en multitarea...