Fórum Problema com Threads... #397112

11/03/2011

0

Delphi

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.
Guilherme Marini

Guilherme Marini

Responder

Posts

11/03/2011

Marco Salles

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 ????
Responder

Gostei + 0

11/03/2011

Guilherme Marini

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!
Responder

Gostei + 0

11/03/2011

Marco Salles

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
Responder

Gostei + 0

11/03/2011

Guilherme Marini

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.
Responder

Gostei + 0

11/03/2011

Marco Salles

Vc tem o delphi 2010 ????
Responder

Gostei + 0

11/03/2011

Guilherme Marini

sim, embarcadero delphi 2010
Responder

Gostei + 0

11/03/2011

Marco Salles

vamos devagarzinho..   Para listar arquivos de um diretório e subdiretório utilizando Delphi 2010 simplesmente faça     
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]));
  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
Responder

Gostei + 0

12/03/2011

Guilherme Marini

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.
Responder

Gostei + 0

12/03/2011

Marco Salles

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????
Responder

Gostei + 0

12/03/2011

Guilherme Marini

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?
Responder

Gostei + 0

12/03/2011

Guilherme Marini

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?
Responder

Gostei + 0

13/03/2011

Guilherme Marini

Alguem pode me ajudar? ainda nao consegui pensar em um jeitu de fazer isso...
Responder

Gostei + 0

19/03/2011

Guilherme Marini

alguem tem a soluçao?
Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar