29 respuestas en este tema

[rgstuamigo]

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;

Bueno en ese caso se puede hacer una mascara algo asi:
Mask='C:\Mi\Ruta\Completa\*.MP3;C:\Mi\Ruta\Completa\*.MP4;C:\Mi\Ruta\Completa\*.Wma' y asi detectaria todos los archivos con esas extensiones, ahora  lo unico que tienes razon es que no busca en las subcarpetas, pero creo, que con la ayuda de estos otros componentes (TDirectoryListBox, TDriveComboBox, TFilterComboBox) se puede emular lo que pretende Enecumene, en su primer post.
Saludos...

[Delphius]

rgstuamigo, puede que con otros componentes se consiga lo que dices pero he aquí­ que no siempre es deseable añadir componentes. Más si no se prevee darle demasiado uso.

Te ahorras un buen espacio. Cada componente que añades va haciendo crecer más al ejecutable, añadiendo más referencias a unidades, funciones y/o procedimientos dentro de éste.

A veces es mejor tener unos métodos que disponer de unos cuantos objetos con sus otras invocaciones, etc.

Saludos,

[egostar]

Hola

Y si a eso le agregamos los problemas con componentes descontinuados o no actualizados a las nuevas versiones de Delphi, pues no quiero saber los problemas que te acarreas si quieres migrar tus aplicaciones a nuevas versiones de Delphi.

Y como dijo mi buen amigo cHackAll, no esta mal quemar algunas neuronas de vez en vez aprendiendo algo de API en lugar de buscar componentes adicionales.

Salud OS

[enecumene]

¡Master!, ¡Usted es un genio, me arrodillo ante ti!  , bueno adaptondolo a mis necesidades hasta ahora ha quedado así­:

delphi

unit Principal;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, xmldom, DB, Provider, Xmlxform,
  DBClient, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    DBGrid1: TDBGrid;
    dsCanciones: TDataSource;
    cdsCanciones: TClientDataSet;
    prCanciones: TXMLTransformProvider;
    cdsCancionesID: TIntegerField;
    cdsCancionesArtista: TStringField;
    cdsCancionesTitulo: TStringField;
    cdsCancionesAlbum: TStringField;
    cdsCancionesGenero: TStringField;
    cdsCancionesAno: TStringField;
    cdsCancionesCalidad: TStringField;
    cdsCancionesRuta: TStringField;
    Timer1: TTimer;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure Process(lpFileName: PChar);
    procedure Search(const lpString: PChar); stdcall;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses ToFunciones;
 
{$R *.dfm}
 
function strstr(lpString, lpStrCharSet: PChar): PChar; cdecl external 'ntdll';
function _strlwr(lpString: PChar): PChar; cdecl external 'ntdll';
 
var
 Path: array [0..MAX_PATH{-1}] of Char;
 FindFileData: TWin32FindData;
 
procedure TForm1.Process(lpFileName: PChar);
var
  Titulo,Artista,Album,Ano,Genero,Comentario,Calidad: String;
begin
  cdsCanciones.CreateDataSet;
  ObtenerID3Tag(lpFileName,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   := lpFileName;
 
      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     := lpFileName;
      cdsCanciones.Post;
end;
 
procedure TForm1.Search(const lpString: PChar); stdcall;
var
 len, hFindHandle: Cardinal;
 lpFileName, lpExt: PChar;
begin
 len := lstrlen(@Path) + 1;
 hFindHandle := FindFirstFile(lstrcat(@Path, '\*.*'), FindFileData);
 if hFindHandle <> INVALID_HANDLE_VALUE then
  begin
   repeat lpFileName := @FindFileData.cFileName; lstrcpy(@Path[len], lpFileName);
    if (FindFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then
     if (PWord(lpFileName)^ <> Ord('.')) and (PWord(@lpFileName[1])^ <> Ord('.')) then // '.' | '..'
      Search(lpString)
     else
    else
     begin
      lpExt := lpFileName;
      while lpFileName[0] <> #0 do
       begin
        if lpFileName[0] = '.' then
         lpExt := lpFileName;
        Inc(lpFileName);
       end;
      PWord(lpFileName)^ := Ord('.');
      if Assigned(strstr(lpString, _strlwr(lpExt))) then
       Process(@Path); // back to VCL :( or any callback!
     end;
   until not FindNextFile(hFindHandle, FindFileData);
   Windows.FindClose(hFindHandle);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 lstrcpy(@Path, 'c:'); // where to search
 Timer1.Tag := CreateThread(nil, 0{}, @Search, PChar('.mp3.wma.mp4.wav.'), 0, PDWORD(0)^); // extensions in lower case with extra point at the end!
 Button1.Visible := False;
 Timer1.Enabled := True;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if WaitForSingleObject((Sender as TComponent).Tag, 0) = WAIT_TIMEOUT then
  begin
   Label1.Caption := Path;
  end
 else
  begin
   (Sender as TTimer).Enabled := False;
   Label1.Caption := '';
   Button1.Visible := True;
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 if Timer1.Enabled then
  TerminateThread(Timer1.Tag, 0);
end;
 
end.

Pero al compilar me da problemas en la lí­nea:

delphi

procedure TForm1.Button1Click(Sender: TObject);
begin
 lstrcpy(@Path, 'c:'); // where to search
 Timer1.Tag := CreateThread(nil, 0{}, @Search, PChar('.mp3.wma.mp4.wav.'), 0, PDWORD(0)^); // Aquí­ se detiene
 Button1.Visible := False;
 Timer1.Enabled := True;
end;

Este es el error:

delphi

[Error] Principal.pas(114): Variable required

Y se posiciona en el puntero @Search, ¿qué hago mal? .

Saludos.

[cHackAll]

delphi

// . . .
 
  private
   {}
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses ToFunciones;
 
{$R *.dfm}
 
function strstr(lpString, lpStrCharSet: PChar): PChar; cdecl external 'ntdll';
function _strlwr(lpString: PChar): PChar; cdecl external 'ntdll';
 
var
 Path: array [0..MAX_PATH{-1}] of Char;
 FindFileData: TWin32FindData;
 
procedure Process(lpFileName: PChar);
var Titulo,Artista,Album,Ano,Genero,Comentario,Calidad: String;
begin
 with Form1 do
  begin
   cdsCanciones.CreateDataSet;
   ObtenerID3Tag(lpFileName,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   := lpFileName;
 
   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     := lpFileName;
   cdsCanciones.Post;
  end;
end;
 
procedure Search(const lpString: PChar); stdcall;
var
 len, hFindHandle: Cardinal;
 lpFileName, lpExt: PChar;
begin
 len := lstrlen(@Path) + 1;
 hFindHandle := FindFirstFile(lstrcat(@Path, '\*.*'), FindFileData);
 if hFindHandle <> INVALID_HANDLE_VALUE then
  begin
   repeat lpFileName := @FindFileData.cFileName; lstrcpy(@Path[len], lpFileName);
    if (FindFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then
     if (PWord(lpFileName)^ <> Ord('.')) and (PWord(@lpFileName[1])^ <> Ord('.')) then // '.' | '..'
      Search(lpString)
     else
    else
     begin
      lpExt := lpFileName;
      while lpFileName[0] <> #0 do
       begin
        if lpFileName[0] = '.' then
         lpExt := lpFileName;
        Inc(lpFileName);
       end;
      PWord(lpFileName)^ := Ord('.');
      if Assigned(strstr(lpString, _strlwr(lpExt))) then
       Process(@Path); // back to VCL :( or any callback!
     end;
   until not FindNextFile(hFindHandle, FindFileData);
   Windows.FindClose(hFindHandle);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 lstrcpy(@Path, 'c:'); // where to search
 Timer1.Tag := CreateThread(nil, 0{}, @Search, PChar('.mp3.wma.mp4.wav.'), 0, PDWORD(0)^); // extensions in lower case with extra point at the end!
 Button1.Visible := False;
 Timer1.Enabled := True;
end;
 
// . . .

[rgstuamigo]

rgstuamigo, puede que con otros componentes se consiga lo que dices pero he aquí­ que no siempre es deseable añadir componentes. Más si no se prevee darle demasiado uso.

Te ahorras un buen espacio. Cada componente que añades va haciendo crecer más al ejecutable, añadiendo más referencias a unidades, funciones y/o procedimientos dentro de éste.

A veces es mejor tener unos métodos que disponer de unos cuantos objetos con sus otras invocaciones, etc.

Saludos,

Bueno... creo que eso ya depende de cada uno, *-)aunque tambien se podria crear los componentes dinamicamente(en Tiempo de ejecucion) y luego eliminarlo(Liberarlos),y ademas no creo que una aplicasion como la que pretende Enecumene pese tanto como para andar pensando en el tamaño del ejecutable,como ejemplo te pongo que yo tengo un ejecutable de casi 10 mega ,como 70 formularios y me funciona muy bien ;pero como ya dije eso depende de cada uno.....

[Delphius]

Pues si rgstuamigo, eso es a gustos de cada uno y de un gran y relativo DEPENDE.

Saludos,

[enecumene]

ChackAll, ese último code está excelente amigo y disculpa la tardanza, fí­jate, perdona si molesto bastante, de veras traté de entender un poco tu code para poder modificarlo y pues no tengo las mismas neuronas que tú, querí­a que así­ como es multi-máscara también fuera multi-path, algo como así­:

delphi

lstrcpy(@Path, PChar('.C:\.D:\.E:\.')); // where to search

No sé si es factible, intenté hacerlo en un ciclo for como verás en este hilo que abrí­, pero nada, no nos sale .

Saludos.

[enecumene]

Estuve pensando si se puede guardar el resultado del conteo en un array y colocarlo en la función lstrcpy, no sé, ¿se podrá?.

[cannabis]

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

Gracias por el dato alquimista. Me estaba quemando las pestañas tratando de inventar el hilo negro y el agua tibia.


Salud.