(Resolvido) Omg! Thread Travando! o que fazer?

[Douglas Soares]

E ae Pessoal, fiz uma thread no intuito de destravar o programa... rsrs... porem ela ta travando tudo.... não consigo mecher em mais nada quando uso ela... alguém pode me ajudar?, ta ai o código da bixona!

unit DownloadThread;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, Gauges, ShellApi, WinSock, registry,
  Grids, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, WinInet,
  ComCtrls, IdFTPList, DB, DBClient, DBGrids;

type
TDownloadThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure EnumFiles(szPath, szAllowedExt: String; iAttributes: Integer;
  Buffer: TStrings; bClear, bIncludePath: Boolean); StdCall;
procedure DownloadFTP(Host, Username, Password, RemoteDir, LocalDir: string);
procedure ApagaPasta(pasta: string);
procedure ClearMemos;
procedure Principal;
end;

implementation
uses cadClientes;

{ TDownloadThread }

procedure TDownloadThread.ApagaPasta(pasta: string);
var
  Arquivo: TSearchRec;
begin
  if FindFirst(pasta+'*.*', 0, Arquivo) = 0 then
  begin
    repeat
      DeleteFile(pasta+Arquivo.Name);
    until FindNext(Arquivo) <> 0;
    FindClose(Arquivo);
end;
end;

procedure TDownloadThread.EnumFiles(szPath, szAllowedExt: String; iAttributes: Integer;
  Buffer: TStrings; bClear, bIncludePath: Boolean); StdCall;
var
  res: TSearchRec;
  szBuff: String;
begin
  if (bClear) then Buffer.Clear;
  szPath := IncludeTrailingBackslash(szPath);
  if (FindFirst(szPath + szAllowedExt, iAttributes, res) = 0) then
  begin
    repeat
      szBuff := res.Name;
      if ((szBuff <> '.') and (szBuff <> '..')) then
      if (bIncludePath) then
      Buffer.Add(szPath + szBuff) else
      Buffer.Add(szBuff);
    until FindNext(res) <> 0;
    FindClose(res);
  end;
end;

procedure TDownloadThread.DownloadFTP(Host, Username, Password, RemoteDir, LocalDir: string);

 procedure DownloadDirectory(idFTP: TidFTP; Directory: string = '');
 var i: integer;
     DirListing: TStringList;
     IdFTPListItems: TIdFTPListItems;
 begin
  // update the GUI
  Application.ProcessMessages();

  // avoid trying to move to and copy current or parent dir
  if (Directory = '.') or (Directory = '..') then
   exit;

  if Directory <> '' then
   try
    // change to directory remotely
    idFTP.ChangeDir(Directory);

    // create and change to directory locally
    CreateDir(Directory);
    SetCurrentDir(Directory);
   
    Directory := IncludeTrailingPathDelimiter(Directory);
   except
    exit;
   end;

  DirListing := TStringList.Create();
  IdFTPListItems := TIdFTPListItems.Create();

  try
   idFTP.List(DirListing);
   IdFTPListItems.LoadList(DirListing);

   for i := 0 to IdFTPListItems.Count - 1 do
   begin
    case IdFTPListItems[i].ItemType of
     ditDirectory:
     begin
      frmCadClientes.Memo1.Lines.Add('Processando Diretório ' + IdFTPListItems[i].FileName);
      DownloadDirectory(idFTP, IdFTPListItems[i].FileName);
     end;

     ditFile:
     begin
      frmCadClientes.Memo1.Lines.Add('Baixando Arquivo ' + IdFTPListItems[i].FileName);
      idFTP.Get(IdFTPListItems[i].FileName, IdFTPListItems[i].FileName, true);
     end;
    end;
   end;

   if Directory <> '' then
   begin
    idFTP.ChangeDirUp();
    SetCurrentDir('..');
   end;
  finally
   DirListing.Free();
   IdFTPListItems.Free();
  end;
 end;

var idFTP: TIdFTP;
begin
 frmCadClientes.Memo1.Clear();

 idFTP := TIdFTP.Create(nil);
 try
  idFTP.Host := Host;
  idFTP.Username := Username;
  idFTP.Password := Password;
  idFTP.Connect();

  idFTP.ChangeDir(RemoteDir);
  ForceDirectories(LocalDir);
  SetCurrentDir(LocalDir);
  DownloadDirectory(idFTP);

  frmCadClientes.Memo1.Lines.Add('Concluido');

  idFTP.Quit();
 finally
  idFTP.Free();
 end;
end;

procedure TDownloadThread.ClearMemos;
var
local : string;
begin
local := ExtractFilePath(Application.ExeName) + '\logs\';
ApagaPasta(local);
frmCadClientes.Memo1.Clear;
frmCadClientes.ListBox1.Clear;
end;

procedure TDownloadThread.Principal;
var
local : string;
f:TextFile;
linha:String;
ii:integer;
nomedolog : string;
begin
local := ExtractFilePath(Application.ExeName) + '\logs\';
if frmCadClientes.cdsClientesOn.Active then
while not frmCadClientes.cdsClientesOn.Eof do
frmCadClientes.cdsClientesOn.Delete
else
frmCadClientes.cdsClientesOn.CreateDataSet;
frmCadClientes.cdsClientesOn.Open;
if not DirectoryExists(local) then
ForceDirectories(local);
DownloadFTP('ftp.meusite.com.br', 'usuario', 'senha123', 'pastaremota', local);
EnumFiles(local, '*.log', faanyfile - faDirectory, FrmCadClientes.Listbox1.Items, False, False);
frmCadClientes.ListBox1.ItemHeight := 0;

for ii:=0 to FrmCadClientes.ListBox1.Items.Count-1 do
begin
try
nomedolog := FrmCadClientes.ListBox1.Items.Strings[ii];
AssignFile(f,local + nomedolog);

Reset(f);

   Readln(f,linha);
   linha := Trim(linha);
   if linha <> '' then
begin
   frmCadClientes.cdsClientesOn.Append;
   frmCadClientes.cdsClientesOn.FieldByName('CODIGO').Value := StrToInt(linha);
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('IGREJA').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('CIDADE').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('ESTADO').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('HORA').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('VERSAO').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('SISTEMA').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('DATA').Text := linha;
   frmCadClientes.cdsClientesOn.Post;
end;
finally
Closefile(f);
end;
end;


FrmCadClientes.lbltotalc.Caption := 'No Momento Existem ' + IntToStr(frmCadClientes.ListBox1.Items.Count) + ' Igrejas Utilizando nossos Sistemas';
if frmCadClientes.cdsClientesOn.IsEmpty then
ShowMessage('No Momento ninguém está Utilizando Nossos Sistemas!');
end;

procedure TDownloadThread.Execute;
begin
Synchronize(ClearMemos);
Synchronize(Principal);
end;

end.

Desde já Agradeço!

[Raficcha]

Hehe, tenta colocar um sleep(1) ai no final do execute. Se o sleep der erro (Undeclareded identifier Sleep) declara "windows" nas uses

procedure TDownloadThread.Execute;
begin
Synchronize(ClearMemos);
Synchronize(Principal);
sleep(1);
end;

depois vouta ai e diz se funcionou

[Douglas Soares]

eheheh, coloquei mas não é esse ainda o ponto.

eu quero que quando eu clique no botão, ele deixe eu continuar mechendo no programa, sem ter q esperar ele fazer o processo da thread... essa é a questão!

Vlw

[Raficcha]

Provavelmente o problema esta quando você esta cincronizando. Você esta jogando o processamento para fora da thread. Para que a thread não trave, o processamento deve ser dentro dela (dentro do execute). Esse procedimento "Principal" é o que faz o programa travar pois ele que faz o download. Tente fazer o download dentro da thread (procedimento execute), e não fora dela

[Douglas Soares]

Amigão, mt obrigado consegui, o problema era o download mesmo, rsrs, então é que me falaram antes q no Execute não podia colocar nome de forms, então o download deixei lá e o resto fui adaptando, ehehe, olha o código ae:

unit DownloadThread;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, Gauges, ShellApi, WinSock, registry,
  Grids, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, WinInet,
  ComCtrls, IdFTPList, DB, DBClient, DBGrids;

type
TDownloadThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure EnumFiles(szPath, szAllowedExt: String; iAttributes: Integer;
  Buffer: TStrings; bClear, bIncludePath: Boolean); StdCall;
procedure DownloadFTP(Host, Username, Password, RemoteDir, LocalDir: string);
procedure ApagaPasta(pasta: string);
procedure ClearMemos;
procedure Principal;
procedure Final;
procedure ProcessoGeral;
end;

implementation
uses cadClientes;

{ TDownloadThread }

procedure TDownloadThread.ApagaPasta(pasta: string);
var
  Arquivo: TSearchRec;
begin
  if FindFirst(pasta+'*.*', 0, Arquivo) = 0 then
  begin
    repeat
      DeleteFile(pasta+Arquivo.Name);
    until FindNext(Arquivo) <> 0;
    FindClose(Arquivo);
end;
end;

procedure TDownloadThread.EnumFiles(szPath, szAllowedExt: String; iAttributes: Integer;
  Buffer: TStrings; bClear, bIncludePath: Boolean); StdCall;
var
  res: TSearchRec;
  szBuff: String;
begin
  if (bClear) then Buffer.Clear;
  szPath := IncludeTrailingBackslash(szPath);
  if (FindFirst(szPath + szAllowedExt, iAttributes, res) = 0) then
  begin
    repeat
      szBuff := res.Name;
      if ((szBuff <> '.') and (szBuff <> '..')) then
      if (bIncludePath) then
      Buffer.Add(szPath + szBuff) else
      Buffer.Add(szBuff);
    until FindNext(res) <> 0;
    FindClose(res);
  end;
end;

procedure TDownloadThread.DownloadFTP(Host, Username, Password, RemoteDir, LocalDir: string);

 procedure DownloadDirectory(idFTP: TidFTP; Directory: string = '');
 var i: integer;
     DirListing: TStringList;
     IdFTPListItems: TIdFTPListItems;
 begin
  // update the GUI
  Application.ProcessMessages();

  // avoid trying to move to and copy current or parent dir
  if (Directory = '.') or (Directory = '..') then
   exit;

  if Directory <> '' then
   try
    // change to directory remotely
    idFTP.ChangeDir(Directory);

    // create and change to directory locally
    CreateDir(Directory);
    SetCurrentDir(Directory);
   
    Directory := IncludeTrailingPathDelimiter(Directory);
   except
    exit;
   end;

  DirListing := TStringList.Create();
  IdFTPListItems := TIdFTPListItems.Create();

  try
   idFTP.List(DirListing);
   IdFTPListItems.LoadList(DirListing);

   for i := 0 to IdFTPListItems.Count - 1 do
   begin
    case IdFTPListItems[i].ItemType of
     ditDirectory:
     begin
      DownloadDirectory(idFTP, IdFTPListItems[i].FileName);
     end;

     ditFile:
     begin
      idFTP.Get(IdFTPListItems[i].FileName, IdFTPListItems[i].FileName, true);
     end;
    end;
   end;

   if Directory <> '' then
   begin
    idFTP.ChangeDirUp();
    SetCurrentDir('..');
   end;
  finally
   DirListing.Free();
   IdFTPListItems.Free();
  end;
 end;

var idFTP: TIdFTP;
begin

 idFTP := TIdFTP.Create(nil);
 try
  idFTP.Host := Host;
  idFTP.Username := Username;
  idFTP.Password := Password;
  idFTP.Connect();

  idFTP.ChangeDir(RemoteDir);
  ForceDirectories(LocalDir);
  SetCurrentDir(LocalDir);
  DownloadDirectory(idFTP);

  idFTP.Quit();
 finally
  idFTP.Free();
 end;
end;

procedure TDownloadThread.ClearMemos;
var
local : string;
begin
local := ExtractFilePath(Application.ExeName) + '\logs\';
ApagaPasta(local);
frmCadClientes.ListBox1.Clear;
end;

procedure TDownloadThread.Principal;
begin
if frmCadClientes.cdsClientesOn.Active then
while not frmCadClientes.cdsClientesOn.Eof do
frmCadClientes.cdsClientesOn.Delete
else
frmCadClientes.cdsClientesOn.CreateDataSet;
frmCadClientes.cdsClientesOn.Open;
end;

procedure TDownloadThread.Final;
begin
FrmCadClientes.lbltotalc.Caption := 'No Momento Existem ' + IntToStr(frmCadClientes.ListBox1.Items.Count) + ' Igrejas Utilizando nossos Sistemas';
if frmCadClientes.cdsClientesOn.IsEmpty then
ShowMessage('No Momento ninguém está Utilizando Nossos Sistemas!');
end;

procedure TDownloadThread.ProcessoGeral;
var
local : string;
f:TextFile;
linha:String;
ii:integer;
nomedolog : string;
begin
local := ExtractFilePath(Application.ExeName) + '\logs\';
frmCadClientes.ListBox1.ItemHeight := 0;

for ii:=0 to FrmCadClientes.ListBox1.Items.Count-1 do
begin
try
nomedolog := FrmCadClientes.ListBox1.Items.Strings[ii];
AssignFile(f,local + nomedolog);

Reset(f);

   Readln(f,linha);
   linha := Trim(linha);
   if linha <> '' then
begin
   frmCadClientes.cdsClientesOn.Append;
   frmCadClientes.cdsClientesOn.FieldByName('CODIGO').Value := StrToInt(linha);
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('IGREJA').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('CIDADE').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('ESTADO').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('HORA').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('VERSAO').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('SISTEMA').Text := linha;
   Readln(f,linha);
   frmCadClientes.cdsClientesOn.FieldByName('DATA').Text := linha;
   frmCadClientes.cdsClientesOn.Post;
end;
finally
Closefile(f);
end;
end;
end;

procedure TDownloadThread.Execute;
var
local : string;
begin
Synchronize(ClearMemos);

local := ExtractFilePath(Application.ExeName) + '\logs\';
Synchronize(Principal);
if not DirectoryExists(local) then
ForceDirectories(local);
DownloadFTP('ftp.meusite.com.br', 'usuario', 'minhasenha', 'pastaremota', pastalocal);
EnumFiles(local, '*.log', faanyfile - faDirectory, FrmCadClientes.Listbox1.Items, False, False);

Synchronize(ProcessoGeral);

Synchronize(Final);

end;

end.

Muuuuuito Obrigado!

[Raficcha]

: D ... sobre chamar o forms dentro das thread: pois é, não da muito certo mesm.. hehe.. já tentei fazer isso aqui... Outro exemplo não muito legal é utilizar showmessages ou outras coisas que fazem interração visual. Se você coloca um showmessage dentro de um thread, os "showmessags" ficam meio "descontrolados".. eles fica com tamanhos totalmente anormais.. hehe

threads são boas tambeim para fazer processamentos "pesadãos".. tipo , criptografar alguma coisa.. ao criptografar um vetor por exemplo, você pode utilizar duas threads, cada uma fazendo metade do serviço, fazendo isso, você utiliza o máximo do clock do processador .. hehe

[Douglas Soares]

Então, essa parte do ShowMessage eu vi mesmo, huahuahua, elas ficam meio doidas, nem quando num é pra eles entrarem elas vem doidonas e de tamanhos malucos, huahuahua, mas beleza, ta tudo OK

Muito Obrigado!