Jump to content

Foto

Localizar Arquivos usando Delphi



Existem 5 respostas neste tópico

#1 flaviotomazio    

flaviotomazio
  • Participante
  • 654 mensagens

Publicado 28 August 2005 - 07:51 PM

Olá pessoal, gostaria de saber como faço para localizar arquivos com uma certa extensão e exibilos numa lista.


Obrigado




 

#2 latander    

latander
  • Participante
  • 51 mensagens

Publicado 28 August 2005 - 09:11 PM


procedure TForm1.Localizar(Local: string; ListBox: TListBox);
var
SearchRec: TSearchRec;
begin
Local:= Trim(Local);
if Local[length(Local)] <> '' then
Local:= Local + '';
SetCurrentDir(Local);
if FindFirst('*.*', faAnyFile, SearchRec) = 0 then // modifica aqui Ex: para mp3 '*.mp3'
Repeat
ListBox.Items.Add(SearchRec.Name);
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;


para usar
Localizar('C:', ListBox1);

falou

#3 flaviotomazio    

flaviotomazio
  • Participante
  • 654 mensagens

Publicado 29 August 2005 - 09:49 AM

No caso o LOCAL seria o que? Como faço para chamar essa procedure quando eu clicar em um botão?


Obrigado



#4 latander    

latander
  • Participante
  • 51 mensagens

Publicado 29 August 2005 - 01:04 PM

Local é o local onde você quer procurar, eu vou por uma unit aqui para você ver .

unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Localizar(Local: string; ListBox: TListBox);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Localizar(Local: string; ListBox: TListBox);
var
SearchRec: TSearchRec;
begin
Local:= Trim(Local);
if Local[length(Local)] <> '' then
Local:= Local + '';
SetCurrentDir(Local);
if FindFirst('*.*', faAnyFile, SearchRec) = 0 then // modifica aqui Ex: para mp3 '*.mp3'
Repeat
ListBox.Items.Add(SearchRec.Name);
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Localizar('C:', ListBox1); // pegando arquivos de C:

{ é assim, para pegar da pasta arquivos e programas
por exemplo: Localizar('C:Arquivos de programas', ListBox1);
ele vai pegar e por os arquivos em uma ListBox}


end;

end.


#5 flaviotomazio    

flaviotomazio
  • Participante
  • 654 mensagens

Publicado 29 August 2005 - 05:40 PM

Valeu funcionou, mas outra duvida, como eu faço para listar do computador inteiro?

#6 latander    

latander
  • Participante
  • 51 mensagens

Publicado 29 August 2005 - 06:55 PM

....................................................................

unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
function RecurseDirectory(FileName: string): TStringList;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

type
PRecInfo = ^TRecInfo;
TRecInfo = record
Prev: PRecInfo;
fPathName: string;
SearchRec: TSearchRec;
end;

implementation

{$R *.dfm}

function TForm1.RecurseDirectory(FileName: string): TStringList;
var
f1, f2: TSearchRec;
p1, tmp: PRecInfo;
fwc: string;
fpath: string;
fbroke1, fbroke2: boolean;
begin
Result:= TStringList.Create;
fpath:= ExtractFilePath(FileName);
fwc:= ExtractFileName(FileName);
New(p1);
p1.fPathName:= fpath;
p1.Prev:= nil;
fbroke1:= false;
fbroke2:= false;
while p1 <> nil do begin
if fbroke1 = false then
if fbroke2 = false then
begin
if FindFirst(fpath + ''*'', faAnyFile, f1) <> 0 then
Break;
end
else if FindNext(f1) <> 0 then begin
Repeat
FindClose(f1);
if p1 = nil then
break;
fpath:= p1.fPathName;
f1:= p1.SearchRec;
tmp:= p1.Prev;
Dispose(p1);
p1:= tmp;
Until FindNext(f1) = 0;
if p1 = nil then Break;
end;
if (f1.Name <> ''.'') and (f1.Name <> ''..'') and ((f1.Attr and faDirectory) = faDirectory) then
begin
fbroke1:= false;
New(tmp);
with tmp^ do begin
fPathName:= fpath;
SearchRec.Time:= f1.Time;
SearchRec.Size:= f1.Size;
SearchRec.Attr:= f1.Attr;
SearchRec.Name:= f1.Name;
SearchRec.ExcludeAttr:= f1.ExcludeAttr;
SearchRec.FindHandle:= f1.FindHandle;
SearchRec.FindData:= f1.FindData;
end;
tmp.Prev:= p1;
p1:= tmp;
fpath:= p1.fPathName+f1.Name+'''';
if FindFirst(fpath+fwc, faAnyFile, f2) = 0 then begin
Result.Add(fpath+f2.Name);
while FindNext(f2) = 0 do
Result.Add(fpath+f2.Name);
FindClose(f2);
end;
fbroke2:= false;
end else begin
if FindNext(f1) = 0 then begin
FindClose(f1);
fpath:= p1.fPathName;
f1:= p1.SearchRec;
fbroke1:= false;
fbroke2:= true;
tmp:= p1.Prev;
Dispose(p1);
p1:= tmp;
end else begin
fbroke1:= true;
fbroke2:= false;
end;
end;
end;
fpath:= ExtractFilePath(FileName);
if FindFirst(FileName, faAnyFile, f1) = 0 then begin
Result.Add(fpath+f2.Name);
while FindNext(f1) = 0 do
Result.Add(fpath+f2.Name);
FindClose(f1);
end;
end;



procedure TForm1.Button1Click(Sender: TObject);
var
l1:Tstringlist;
begin
l1:=tstringlist.create;
listbox1.items.clear;
listbox1.Items.BeginUpdate;
l1:= recursedirectory(''C:*.*'');
listbox1.items.assign(l1);
freeandnil(l1);
listbox1.Items.endUpdate;
end;

end.


se alguém puder corrigir isso aí para mim, só está listando pastas