Aplicacion de Busqueda Recursiva de Archivos en Disco
 

Saludos comunidad de amigos, la situación que me embarga ahora es la siguiente: Tengo Varios Discos USB de 1 Tb donde tengo todos mis instaladores y video tutoriales entre otras cosas, y deseo hacer un software autoplay que me permita ingresar un nombre (puede ser el de un archivo directamente o el de una carpeta) y me permita listar las coincidencias en un componente que permita ejecutar el archivo ( o llamar al programa asociado) al darle doble click.

Muchas gracias por su atención.

Atte

Americo Torres

Hola, mira esto

Yo que tu le echaba un ojo a este componente: TFindFile

Saludos.

Creo que en este truco tienes el código que necesitas.

Saludos
 

Gracias a todos aquellos amigos que respondieron, he probado cada código, ciertamente resuelven parte del problema, sin embargo, el problema en ellos es que buscan "mascaras", de la forma: *.pas, Arch.*, etc. por eso si existe un archivo llamado por ejemplo: INS_PHOTOSHOP_CC_14.EXE, no podre ubicarlo ingresando la palabra PHOTOSHOP, porque el archivo no comienza con dicha palabra.

El código que presento a continuación es la versión de Neftalí, pero presenta esta limitación:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FindFile, StdCtrls;

type
  TForm1 = class(TForm)
    Buscar: TButton;
    lstArchivos: TListBox;
    Label1: TLabel;
    txtBuscar: TEdit;
    procedure BuscarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure FindFiles(StartDir, FileMask: string; recursively: boolean; var FilesList: TStringList);
  const
    MASK_ALL_FILES = '*.*';
    CHAR_POINT = '.';
  var
    SR: TSearchRec;
    DirList: TStringList;
    IsFound: Boolean;
    i: integer;
  begin
    if (StartDir[length(StartDir)] <> '\') then begin
      StartDir := StartDir + '\';
    end;

    // Crear la lista de ficheos en el directorio StartDir (no directorios!)
    IsFound := FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0;
    // MIentras encuentre
    while IsFound do  begin
      FilesList.Add(StartDir + SR.Name);
      IsFound := FindNext(SR) = 0;
    end;

    FindClose(SR);

    // Recursivo?
    if (recursively) then begin
      // Build a list of subdirectories
      DirList := TStringList.Create;
      // proteccion
      try
        IsFound := FindFirst(StartDir + MASK_ALL_FILES, faAnyFile, SR) = 0;
        while IsFound do
        begin
          if ((SR.Attr and faDirectory) <> 0) and
            (SR.Name[1] <> CHAR_POINT) then
            DirList.Add(StartDir + SR.Name);
          IsFound := FindNext(SR) = 0;
        end;
        FindClose(SR);

        // Scan the list of subdirectories
        for i := 0 to DirList.Count - 1 do
          FindFiles(DirList[i], FileMask, recursively, FilesList);
      finally
        DirList.Free;
      end;
    end;
  end;

procedure TForm1.BuscarClick(Sender: TObject);
var
  res:TStringList;
  i:integer;
begin
  res:=TStringList.Create;
  FindFiles('.',txtBuscar.Text+'*.*',true,res);
  for i := 0 to res.Count - 1 do
      lstArchivos.Items.Add(res[i]);
end;

end.

Saludos

Lo que buscas es similar a los launchers como http://www.launchy.net/ (que a proposito, hace lo que quieres ya).

Lo que se hace es crear una base de datos donde se almacenan metadatos de los archivos y sobre la que se hace las busquedas. Una forma trivial de hacerlo es usando sqlite + Full text search. Busca en google como se usa el FTS de sqlite.

Hola darkamerico.

De este modo te devuelve en un sólo TStrings todas las carpetas y archivos cuyo nombre contenga la cadena buscada:

Código Delphi [-]
procedure FindFiles(Folder, StrSearched :string; TS: TStrings);
var
  SR: TSearchRec;
  Found: Boolean;
begin
  Screen.Cursor := crHourGlass;
  try
    Folder:= IncludeTrailingPathDelimiter(Folder);
    if FindFirst(Folder + '*.*', faDirectory, SR) = 0 then
    repeat
      Found:= Pos(UpperCase(StrSearched), UpperCase(SR.Name)) <> 0; // ignora mayúsc./minúsc.
      if ((SR.Attr and fadirectory) = fadirectory) then
      begin
        if(SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if Found then
            TS.Add(Folder + SR.Name );
          FindFiles(Folder + SR.Name, StrSearched, TS)
        end
      end
      else if Found then
        TS.Add(Folder + SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  finally
    Screen.Cursor := crDefault;
  end;
end;

Ejemplo de uso:

Código Delphi [-]
...
begin
  FindFiles('c:\windows', 'debug', ListBoxOccurs.Items);
...

Si queres almacenar carpetas y archivos en dos TStrings diferentes, basta una pequeña modificación:

Código Delphi [-]
procedure FindFiles(Folder, StrSearched :string; TS1, TS2: TStrings);
var
  SR: TSearchRec;
  Found: Boolean;
begin
  Screen.Cursor := crHourGlass;
  try
    Folder:= IncludeTrailingPathDelimiter(Folder);
    if FindFirst(Folder + '*.*', faDirectory, SR) = 0 then
    repeat
      Found:= Pos(UpperCase(StrSearched), UpperCase(SR.Name)) <> 0; // ignora mayúsc./minúsc.
      if ((SR.Attr and fadirectory) = fadirectory) then
      begin
        if(SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if Found then
            TS1.Add(Folder + SR.Name );
          FindFiles(Folder + SR.Name, StrSearched, TS1, TS2)
        end
      end
      else if Found then
        TS2.Add(Folder + SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  finally
    Screen.Cursor := crDefault;
  end;
end;

Uso:

Código Delphi [-]
...
begin
  FindFiles('c:\windows', 'system', MemoFolders.Lines, MemoFiles.Lines);
...

Saludos :)

Mil Gracias ecfisa
 

Como siempre dando en el clavo, gracias hermano, saludos