Ver Mensaje Individual
  #1  
Antiguo 15-01-2008
lgarcia lgarcia is offline
Miembro
 
Registrado: jul 2004
Posts: 506
Reputación: 22
lgarcia Va por buen camino
Ficheros de video

Hola:

Estoy haciendo un programita para realizar auditorias en las PC sobre archivos de video para mostrarlos en un Memo, existe alguna forma de poder incluir todos los tipos de extensiones de video en una sola consulta, el codigo es el siguiente:

Código:
unit Entrada;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FileCtrl;
type
  TForm1 = class(TForm)
    btnBuscar: TButton;
    DriveComboBox1: TDriveComboBox;
    Memo1: TMemo;
    cbExtension: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    procedure btnBuscarClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
var
  lista: TStrings;
procedure BuscarArchivos(const directorio, mascara: string;
  atributos: Integer; var listado: TStrings);
  // Procedimiento anidado
  procedure Buscar(const subdirectorio: string);
  var
    regBusqueda: TSearchRec;
  begin
    // Buscar en el directorio
    if FindFirst(subdirectorio + mascara,atributos,regBusqueda) = 0 then
    begin
      try
        repeat
          Application.ProcessMessages;
          if (regBusqueda.Attr and faDirectory = 0)
            or (regBusqueda.Name <> '.')
              and (regBusqueda.Name <> '..') then
                listado.Add(subdirectorio + regBusqueda.Name);
        until FindNext(regBusqueda) <> 0;
      except
        FindClose(regBusqueda);
      end;
      FindClose(regBusqueda);
    end;
    // Buscar en los subdirectorios
    if FindFirst(subdirectorio + '*', atributos
      or faDirectory, regBusqueda) = 0 then
    begin
      try
        repeat
          Application.ProcessMessages;
          if ((regBusqueda.Attr and faDirectory) <> 0)
            and (regBusqueda.Name <> '.')
              and (regBusqueda.Name <> '..') then
                Buscar(subdirectorio + regBusqueda.Name + '\');
        until FindNext(regBusqueda) <> 0;
      except
        FindClose(regBusqueda);
      end;
      FindClose(regBusqueda);
    end;
  end;
begin
  Buscar(IncludeTrailingPathDelimiter(directorio));
end;
procedure TForm1.btnBuscarClick(Sender: TObject);
var
  unidad:string[3];
begin
  Memo1.Clear;
  unidad:= copy(DriveComboBox1.Text, 1, 2) + '\';
  lista:= TStringList.Create;
  BuscarArchivos(unidad, cbExtension.Text, faAnyFile, lista);
  if lista.Text = '' then ShowMessage('No existe ningun fichero de ese tipo')
  else Memo1.Text:= lista.Text;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  Memo1.Text:= '';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  lista.Free;
  Close;
end;
end.
Pero de la forma que lo estoy haciendo, tengo que ir seleccionado en el cbExtension los diferentes tipos de extensiones de video.

Espero haberme hecho explicar.

Muchas gracias

Saludos

Luis Garcia
Responder Con Cita