Problema com Threads...
Apresentei um problema aqui no forum e me foi solucionado com a indicaçao de uso de trheads, pesquisei e comecei a usa-la, bom, estou encrontrando problema em alguma parte da minha thread, e como nao sei oque é permitido ou nao usar dentro de uma thread, vou postar o codigo da thread aqui:
procedure MinhaThread.Execute;
begin
Fileslist := TStringList.Create;
LComparar := TStringList.Create;
synchronize(copiar);
FindFiles(FilesList, 'c:', '*.*', True);
{ Place thread code here }
end;
procedure MinhaThread.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot: boolean);
begin
if length(StartDir) <> 0 then
begin
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l := 0 to LComparar.Count - 1 do
begin
Mascara := LComparar[l];
IsFound := FindFirst(StartDir + Mascara, faAnyFile - faDirectory, SR) = 0;
while IsFound do
begin
FilesList.Add(StartDir + SR.Name);
synchronize(AtualizaResult);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot = true then
// Cria lista de subdirectorios
IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do
begin
ListaDir := TStringList.Create;
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
begin
ListaDir.Add(StartDir + SR.Name);
// synchronize(AtualizaBusca);
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
startdir:=listadir[i];
FindFiles(FilesList, ListaDir[i], Mascara, IncludeRoot);
ListaDir.free;
end;
end;
procedure MinhaThread.copiar;
begin
LComparar.Assign(form5.LComparar.Items);
end;
procedure MinhaThread.AtualizaBusca;
begin
form5.LProcurando.Items.Assign(ListaDir);
end;
procedure MinhaThread.AtualizaResult;
begin
form5.LEncontrado.Items.Assign(FilesList);
end;
Até a parte do includeroote=true o codigo funciona, o problema esta no looping para procurar em subdiretorios eu acho, pois se eu executo FindFiles(..,..,..,False) ele transcorre bem, e procura os arquivos numa boa, mas quando é pra começar a procurar em subdiretorios, que foi aquele looping que eu criei com StringList ele da erro, o erro é na hora da utilizaçao, o erro que persiste agora é o "Out Of Memory"..
Como soluciono.
procedure MinhaThread.Execute;
begin
Fileslist := TStringList.Create;
LComparar := TStringList.Create;
synchronize(copiar);
FindFiles(FilesList, 'c:', '*.*', True);
{ Place thread code here }
end;
procedure MinhaThread.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot: boolean);
begin
if length(StartDir) <> 0 then
begin
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l := 0 to LComparar.Count - 1 do
begin
Mascara := LComparar[l];
IsFound := FindFirst(StartDir + Mascara, faAnyFile - faDirectory, SR) = 0;
while IsFound do
begin
FilesList.Add(StartDir + SR.Name);
synchronize(AtualizaResult);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot = true then
// Cria lista de subdirectorios
IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do
begin
ListaDir := TStringList.Create;
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
begin
ListaDir.Add(StartDir + SR.Name);
// synchronize(AtualizaBusca);
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
startdir:=listadir[i];
FindFiles(FilesList, ListaDir[i], Mascara, IncludeRoot);
ListaDir.free;
end;
end;
procedure MinhaThread.copiar;
begin
LComparar.Assign(form5.LComparar.Items);
end;
procedure MinhaThread.AtualizaBusca;
begin
form5.LProcurando.Items.Assign(ListaDir);
end;
procedure MinhaThread.AtualizaResult;
begin
form5.LEncontrado.Items.Assign(FilesList);
end;
Até a parte do includeroote=true o codigo funciona, o problema esta no looping para procurar em subdiretorios eu acho, pois se eu executo FindFiles(..,..,..,False) ele transcorre bem, e procura os arquivos numa boa, mas quando é pra começar a procurar em subdiretorios, que foi aquele looping que eu criei com StringList ele da erro, o erro é na hora da utilizaçao, o erro que persiste agora é o "Out Of Memory"..
Como soluciono.
Guilherme Marini
Curtidas 0
Respostas
Marco Salles
11/03/2011
beleza , vc ter disponilizado os métodos. Mas não daria para disponibilizar a uint toda . e tb como vc esta chamando esta THread ??? quem é LProcurando ????
GOSTEI 0
Guilherme Marini
11/03/2011
unit Unit7;
interface
uses
Classes, Sysutils;
type
MinhaThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure FindFiles(FilesList: TStringList; StartDir, Mascara: string;
IncludeRoot: boolean);
procedure AtualizaBusca;
procedure AtualizaResult;
procedure copiar;
end;
var
startdir, mascara: string;
includeroot : boolean;
ListaDir, LComparar, FilesList: TStringList;
SR: TSearchRec;
IsFound: boolean;
i, l: integer;
implementation
uses unit5;
procedure MinhaThread.Execute;
begin
Fileslist := TStringList.Create;
LComparar := TStringList.Create;
synchronize(copiar);
FindFiles(FilesList, 'c:', '*.*', True);
{ Place thread code here }
end;
procedure MinhaThread.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot: boolean);
begin
if length(StartDir) <> 0 then
begin
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l := 0 to LComparar.Count - 1 do
begin
Mascara := LComparar[l];
IsFound := FindFirst(StartDir + Mascara, faAnyFile - faDirectory, SR) = 0;
while IsFound do
begin
FilesList.Add(StartDir + SR.Name);
synchronize(AtualizaResult);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot = true then
// Cria lista de subdirectorios
IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do
begin
ListaDir := TStringList.Create;
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
begin
ListaDir.Add(StartDir + SR.Name);
// synchronize(AtualizaBusca);
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
startdir:=listadir[i];
FindFiles(FilesList, ListaDir[i], Mascara, IncludeRoot);
ListaDir.free;
end;
end;
procedure MinhaThread.copiar;
begin
LComparar.Assign(form5.LComparar.Items);
end;
procedure MinhaThread.AtualizaBusca;
begin
form5.LProcurando.Items.Assign(ListaDir);
end;
procedure MinhaThread.AtualizaResult;
begin
form5.LEncontrado.Items.Assign(FilesList);
end;
end.
essa eh a unit da thread, desconsidere esse LProcurando, eh apenas um tlistbox que vai listando as pastas procuradas, mas note que eu nao estou usando ela ainda, o LComparar eh uma Tlist box da unit principal que tem os filtros da busca, e o LEncontrado eh um TListbox onde vai ser inserido o resultado da busca.
estou chamando a thread assim:
procedure TForm5.BProcurarClick(Sender: TObject);
var FilesList : TStringList;
begin
Teste := MinhaThread.Create(true);
Teste.FreeOnTerminate := true;
Teste.Priority := tpNormal;
Teste.Resume;
end;
onde esta o erro, como eu ja disse, a thread eh executada numa boa se eu deixo o Includeroot como false, ou seja o problema esta no looping pra listar e procurar nas subpastas!
interface
uses
Classes, Sysutils;
type
MinhaThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure FindFiles(FilesList: TStringList; StartDir, Mascara: string;
IncludeRoot: boolean);
procedure AtualizaBusca;
procedure AtualizaResult;
procedure copiar;
end;
var
startdir, mascara: string;
includeroot : boolean;
ListaDir, LComparar, FilesList: TStringList;
SR: TSearchRec;
IsFound: boolean;
i, l: integer;
implementation
uses unit5;
procedure MinhaThread.Execute;
begin
Fileslist := TStringList.Create;
LComparar := TStringList.Create;
synchronize(copiar);
FindFiles(FilesList, 'c:', '*.*', True);
{ Place thread code here }
end;
procedure MinhaThread.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot: boolean);
begin
if length(StartDir) <> 0 then
begin
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l := 0 to LComparar.Count - 1 do
begin
Mascara := LComparar[l];
IsFound := FindFirst(StartDir + Mascara, faAnyFile - faDirectory, SR) = 0;
while IsFound do
begin
FilesList.Add(StartDir + SR.Name);
synchronize(AtualizaResult);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot = true then
// Cria lista de subdirectorios
IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do
begin
ListaDir := TStringList.Create;
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
begin
ListaDir.Add(StartDir + SR.Name);
// synchronize(AtualizaBusca);
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
startdir:=listadir[i];
FindFiles(FilesList, ListaDir[i], Mascara, IncludeRoot);
ListaDir.free;
end;
end;
procedure MinhaThread.copiar;
begin
LComparar.Assign(form5.LComparar.Items);
end;
procedure MinhaThread.AtualizaBusca;
begin
form5.LProcurando.Items.Assign(ListaDir);
end;
procedure MinhaThread.AtualizaResult;
begin
form5.LEncontrado.Items.Assign(FilesList);
end;
end.
essa eh a unit da thread, desconsidere esse LProcurando, eh apenas um tlistbox que vai listando as pastas procuradas, mas note que eu nao estou usando ela ainda, o LComparar eh uma Tlist box da unit principal que tem os filtros da busca, e o LEncontrado eh um TListbox onde vai ser inserido o resultado da busca.
estou chamando a thread assim:
procedure TForm5.BProcurarClick(Sender: TObject);
var FilesList : TStringList;
begin
Teste := MinhaThread.Create(true);
Teste.FreeOnTerminate := true;
Teste.Priority := tpNormal;
Teste.Resume;
end;
onde esta o erro, como eu ja disse, a thread eh executada numa boa se eu deixo o Includeroot como false, ou seja o problema esta no looping pra listar e procurar nas subpastas!
GOSTEI 0
Marco Salles
11/03/2011
me parece que tem erro de lógica o processamento
executei e fica no loop
while IsFound do
begin
ListaDir := TStringList.Create; por isto o erro de Out Of Memory .. Fica instanciando essas listas ... Realmente a THread é indicado para destravar a aplicação , ja que o calculoo é feito em segundo Plano seria melhor talves ( ao ter que conserar o seu cógido que para mim apresenta problema ) e fazer utilizando outra lógica . O que vc pretende listar no ListBox qnd vc cria esta THread ??? ps) eu disse me parece ... .. para finalizar so dois adendos 1) Vc conhece o DirectoryListBox ???? Nativo do Delphi 2)Unidade IOutils.pas … Similar ao NomeSpace System.IO presente no .NET Possui Classes que facilita o Trabalho com Arquivos e Diretórios TDirectory TPath TFile
begin
ListaDir := TStringList.Create; por isto o erro de Out Of Memory .. Fica instanciando essas listas ... Realmente a THread é indicado para destravar a aplicação , ja que o calculoo é feito em segundo Plano seria melhor talves ( ao ter que conserar o seu cógido que para mim apresenta problema ) e fazer utilizando outra lógica . O que vc pretende listar no ListBox qnd vc cria esta THread ??? ps) eu disse me parece ... .. para finalizar so dois adendos 1) Vc conhece o DirectoryListBox ???? Nativo do Delphi 2)Unidade IOutils.pas … Similar ao NomeSpace System.IO presente no .NET Possui Classes que facilita o Trabalho com Arquivos e Diretórios TDirectory TPath TFile
GOSTEI 0
Guilherme Marini
11/03/2011
cara voce ainda nao intendeu o proposito do meu programa, é o seguinte, meu programa ira fazer uma varredura no computador procurando por arquivos com nomes iguais a de uma listbox que eu criei.
eu consegui fazer atraves desse processo citado acima com que ele busque os arquivos em c:, e com sucesso, ele acha todos os arquivos que mandei procurar.
mas eu estou com problema na hora de procurar esses arquivos nos sub-diretorios
eu estou fazendo o seguinte esquema, usando a procedure FindFiles(FileList,StartDir,Mascara,includeroot)
ou seja FindFiles('Liststring para salvar resultados da busca','Diretorio de onde começar a busca','tipo d arquivos que procurar(nao interfere pois eu mudo dentro do procedure','Incluir subdiretorios')
Na minha cabeça o programa deveria agir assim:
1º Ele faz a busca em c:, que é o primeiro diretorio a ser procurado, e salva se achar algum arquivo na stringlist(FileList).
2º Ele procura agora pelas pastas dentro de c: e salva na stringlist(ListaDir)
3º Ele pega cada string da stringlist(ListDir), usa como StartDir e executa a procedure FindFiles denovo.
desse jeitu ele criaria um looping no qual ele continuaria a procurar dentro de um diretorio ate nao haver mais pasta, dae ele volta la no começo e pega a segunda string da string list e faz o mesmo processo, ate ele ter procurado em todas as pastas.
olhe, achei um jeitu em que ele nao da erro out of memory, maaaass ele tambem nao procura tudo, stacka em algum lugar.
unit Unit7;
interface
uses
Classes, Sysutils;
type
MinhaThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure FindFiles(FilesList: TStringList; StartDir, Mascara: string;
IncludeRoot: boolean);
procedure AtualizaBusca;
procedure AtualizaResult;
procedure copiar;
end;
var
startdir, mascara: string;
includeroot : boolean;
ListaDir, LComparar, FilesList: TStringList;
SR: TSearchRec;
IsFound: boolean;
i, l: integer;
implementation
uses unit5;
procedure MinhaThread.Execute;
begin
Fileslist := TStringList.Create;
LComparar := TStringList.Create;
synchronize(copiar);
FindFiles(FilesList, 'c:', '*.*', True);
{ Place thread code here }
end;
procedure MinhaThread.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot: boolean);
begin
if length(StartDir) <> 0 then
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l := 0 to LComparar.Count - 1 do
begin
Mascara := LComparar[l];
IsFound := FindFirst(StartDir + Mascara, faAnyFile - faDirectory, SR) = 0;
while IsFound do begin
FilesList.Add(StartDir + SR.Name);
synchronize(AtualizaResult);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot = true then
begin
// Cria lista de subdirectorio
ListaDir := TStringList.Create;
IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
begin
ListaDir.Add(StartDir + SR.Name);
// synchronize(AtualizaBusca);
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
FindFiles(FilesList, ListaDir[i], Mascara, IncludeRoot);
ListaDir.free;
end;
end;
procedure MinhaThread.copiar;
begin
LComparar.Assign(form5.LComparar.Items);
end;
procedure MinhaThread.AtualizaBusca;
begin
form5.LProcurando.Items.Assign(ListaDir);
end;
procedure MinhaThread.AtualizaResult;
begin
form5.LEncontrado.Items.Assign(FilesList);
end;
end.
cara se voce souber algum jeitu de eu procurar arquivos com com base em uma lista de nomes e extensoes, que procure em sub-diretorios tambem, por favor me diga, passe uma unit pronta se possivel.
eu consegui fazer atraves desse processo citado acima com que ele busque os arquivos em c:, e com sucesso, ele acha todos os arquivos que mandei procurar.
mas eu estou com problema na hora de procurar esses arquivos nos sub-diretorios
eu estou fazendo o seguinte esquema, usando a procedure FindFiles(FileList,StartDir,Mascara,includeroot)
ou seja FindFiles('Liststring para salvar resultados da busca','Diretorio de onde começar a busca','tipo d arquivos que procurar(nao interfere pois eu mudo dentro do procedure','Incluir subdiretorios')
Na minha cabeça o programa deveria agir assim:
1º Ele faz a busca em c:, que é o primeiro diretorio a ser procurado, e salva se achar algum arquivo na stringlist(FileList).
2º Ele procura agora pelas pastas dentro de c: e salva na stringlist(ListaDir)
3º Ele pega cada string da stringlist(ListDir), usa como StartDir e executa a procedure FindFiles denovo.
desse jeitu ele criaria um looping no qual ele continuaria a procurar dentro de um diretorio ate nao haver mais pasta, dae ele volta la no começo e pega a segunda string da string list e faz o mesmo processo, ate ele ter procurado em todas as pastas.
olhe, achei um jeitu em que ele nao da erro out of memory, maaaass ele tambem nao procura tudo, stacka em algum lugar.
unit Unit7;
interface
uses
Classes, Sysutils;
type
MinhaThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure FindFiles(FilesList: TStringList; StartDir, Mascara: string;
IncludeRoot: boolean);
procedure AtualizaBusca;
procedure AtualizaResult;
procedure copiar;
end;
var
startdir, mascara: string;
includeroot : boolean;
ListaDir, LComparar, FilesList: TStringList;
SR: TSearchRec;
IsFound: boolean;
i, l: integer;
implementation
uses unit5;
procedure MinhaThread.Execute;
begin
Fileslist := TStringList.Create;
LComparar := TStringList.Create;
synchronize(copiar);
FindFiles(FilesList, 'c:', '*.*', True);
{ Place thread code here }
end;
procedure MinhaThread.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot: boolean);
begin
if length(StartDir) <> 0 then
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l := 0 to LComparar.Count - 1 do
begin
Mascara := LComparar[l];
IsFound := FindFirst(StartDir + Mascara, faAnyFile - faDirectory, SR) = 0;
while IsFound do begin
FilesList.Add(StartDir + SR.Name);
synchronize(AtualizaResult);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot = true then
begin
// Cria lista de subdirectorio
ListaDir := TStringList.Create;
IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
begin
ListaDir.Add(StartDir + SR.Name);
// synchronize(AtualizaBusca);
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
FindFiles(FilesList, ListaDir[i], Mascara, IncludeRoot);
ListaDir.free;
end;
end;
procedure MinhaThread.copiar;
begin
LComparar.Assign(form5.LComparar.Items);
end;
procedure MinhaThread.AtualizaBusca;
begin
form5.LProcurando.Items.Assign(ListaDir);
end;
procedure MinhaThread.AtualizaResult;
begin
form5.LEncontrado.Items.Assign(FilesList);
end;
end.
cara se voce souber algum jeitu de eu procurar arquivos com com base em uma lista de nomes e extensoes, que procure em sub-diretorios tambem, por favor me diga, passe uma unit pronta se possivel.
GOSTEI 0
Marco Salles
11/03/2011
Vc tem o delphi 2010 ????
GOSTEI 0
Guilherme Marini
11/03/2011
sim, embarcadero delphi 2010
GOSTEI 0
Marco Salles
11/03/2011
vamos devagarzinho..
Para listar arquivos de um diretório e subdiretório utilizando Delphi 2010 simplesmente faça
simples assim
ps) ja que vc tem o delphi 2010 tente no lugar do edtDirectory.text colocar o DirectoryListBox1.Directory
da classe TDirectoryListBox ... Na Pallette Win 3.1
var
path:string;
i:integer;
begin
if not TDirectory.Exists(edtDirectory.text) then
Caption := 'Invalid Path'
else
Caption := DirectoryListBox1.Directory;
ListBox1.Clear;
for path in TDirectory.GetFiles(edtDirectory.text,
edtFilter.Text,
TSearchOption.soAllDirectories) do
ListBox1.Items.Add(Format('Name = %s', [Path]));GOSTEI 0
Guilherme Marini
11/03/2011
eu ainda nao sei como fazer, voce poderia dar um exemplo, pois eu preciso que o programa procure em todas as pastas do sistema, e que procura po arquivos que estarao listados em uma listbox.
GOSTEI 0
Marco Salles
11/03/2011
eu ainda nao sei como fazer, voce poderia dar um exemplo, pois eu preciso que o programa procure em todas as pastas do sistema, e que procura po arquivos que estarao listados em uma listbox.
então .. esses Arquivos que estão listados neste listBox seriam uam espécie de filtro????
GOSTEI 0
Guilherme Marini
11/03/2011
sim, eh um filtro que vai dize qual arquivos procurar, porque ele vai procurar por uma lista de uns 10 nomes.. e se eu quiser adicionar depois eu só prociso adiciona na listbox... =)
tem alguma ideia de como fazer?
tem alguma ideia de como fazer?
GOSTEI 0
Guilherme Marini
11/03/2011
Olha essa unit funciona muito bem para fazer as buscas, soh que eu queria ela em thread pro prgrama nao travar quando eu mandar fazer a busca..
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, unit7;
type
TForm5 = class(TForm)
BProcurar: TButton;
LEncontrado: TListBox;
LProcurando: TListBox;
LComparar: TListBox;
ListaDir: TListBox;
procedure BProcurarClick(Sender: TObject);
private
procedure FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot:boolean);
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
teste: MinhaThread;
implementation
{$R *.dfm}
procedure TForm5.BProcurarClick(Sender: TObject);
var FilesList : TStringList;
begin
FilesList := TStringList.Create;
findfiles(FilesList,'c:','*.*',true);
LEncontrado.Items.Assign(Fileslist);
end;
procedure TForm5.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot:boolean);
var
SR: TSearchRec;
ListaDir: TStringList;
IsFound: Boolean;
i,l: integer;
begin
if length(StartDir)<>0 then
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l:=0 to LComparar.Count-1 do
begin
Mascara:=LComparar.Items[l];
IsFound :=FindFirst(StartDir+Mascara, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
FilesList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot=true then
begin
// Cria lista de subdirectorios
ListaDir := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory)<>0) and
(SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
ListaDir.Add(StartDir + SR.Name);
LProcurando.Items.Assign(ListaDir);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
FindFiles(FilesList, ListaDir[i], Mascara,includeroot);
ListaDir.Free;
end;
end;
end.
Da pra por na thread?
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, unit7;
type
TForm5 = class(TForm)
BProcurar: TButton;
LEncontrado: TListBox;
LProcurando: TListBox;
LComparar: TListBox;
ListaDir: TListBox;
procedure BProcurarClick(Sender: TObject);
private
procedure FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot:boolean);
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
teste: MinhaThread;
implementation
{$R *.dfm}
procedure TForm5.BProcurarClick(Sender: TObject);
var FilesList : TStringList;
begin
FilesList := TStringList.Create;
findfiles(FilesList,'c:','*.*',true);
LEncontrado.Items.Assign(Fileslist);
end;
procedure TForm5.FindFiles(FilesList: TStringList; StartDir, Mascara: string; IncludeRoot:boolean);
var
SR: TSearchRec;
ListaDir: TStringList;
IsFound: Boolean;
i,l: integer;
begin
if length(StartDir)<>0 then
if StartDir[length(StartDir)] <> '\' then
begin
StartDir := StartDir + '\';
end;
for l:=0 to LComparar.Count-1 do
begin
Mascara:=LComparar.Items[l];
IsFound :=FindFirst(StartDir+Mascara, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
FilesList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
if IncludeRoot=true then
begin
// Cria lista de subdirectorios
ListaDir := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory)<>0) and
(SR.Name[1] <> '.') and (SR.Name <> 'Windows') then
ListaDir.Add(StartDir + SR.Name);
LProcurando.Items.Assign(ListaDir);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
// Procura dentro da lista
for i := 0 to ListaDir.Count - 1 do
FindFiles(FilesList, ListaDir[i], Mascara,includeroot);
ListaDir.Free;
end;
end;
end.
Da pra por na thread?
GOSTEI 0
Guilherme Marini
11/03/2011
Alguem pode me ajudar? ainda nao consegui pensar em um jeitu de fazer isso...
GOSTEI 0
Guilherme Marini
11/03/2011
alguem tem a soluçao?
GOSTEI 0