![]() |
![]() |
| Paypal | FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
#1
|
|||
|
|||
|
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.
Espero haberme hecho explicar. Muchas gracias Saludos Luis Garcia |
|
#3
|
||||
|
||||
|
En lugar de un combo normal, usa un checkListBox, allí indicas todas las extensiones posibles, si están marcadas, la añades a la búsqueda.
FindFirst creo solo puede buscar por un patrón a la misma vez, es decir por una sola extensión. La solución pasa por buscar el patrón *.* y por cada archivo encontrado, ver si la extensión pertenece a la lista de extensiones marcadas en el CheckListBox. Saludos
__________________
Si usted entendió mi comentario, contácteme y gustosamente, se lo volveré a explicar hasta que no lo entienda, Gracias. |
![]() |
| Herramientas | Buscar en Tema |
| Desplegado | |
|
|
Temas Similares
|
||||
| Tema | Autor | Foro | Respuestas | Último mensaje |
| video | machingol | Varios | 3 | 16-05-2007 20:18:47 |
| Video TCP/IP | Onti | Redes | 0 | 13-02-2007 01:00:27 |
| Insertar Video, o vista preeliminar de video | JuanErasmo | .NET | 0 | 10-01-2007 20:27:20 |
| Guardar Video | sierraja | Varios | 0 | 29-03-2005 02:54:58 |
| Video Net | ramonibk | Varios | 0 | 23-12-2004 13:48:57 |
|