duvida (sistema muito pesado)

[danielrgoes]

boa tarde pessoal

estou com uma duvida

eu desenvolvi um sistema que possui um rotina em um botao

essa rotina é bem pesada

possui varios calculos, whiles selects e grava no banco da rede

quando essa rotina esta sendo executada eu não posso mexer em nada no computador que o programa trava e fica sem responder

alguém tem alguma dica para melhorar isso

muito obrigado

[Churc]

Opa

A resposta para seus problemas se chama Thread

Da uma olhada

http://greatis.com/delphicb/tips/lib/appli...ynchthread.html

http://scriptbrasil.com.br/forum/index.php?showtopic=136897

abrxxx

[danielrgoes]

Opa

A resposta para seus problemas se chama Thread

Da uma olhada

http://greatis.com/delphicb/tips/lib/appli...ynchthread.html

http://scriptbrasil.com.br/forum/index.php?showtopic=136897

abrxxx

posso postar um pedaço do codigo para você me ajudar com as threads?

[Churc]

claro brother pode sim :)

abrx

[danielrgoes]

claro brother pode sim :)

abrx

if SBDesenhos.Down = true then

begin

// delete tudo da tabela

modulo.cds_arquivos.close;

modulo.sql_arquivos.sql.clear;

modulo.sql_arquivos.sql.Add('DELETE FROM ARQUIVOS ');

modulo.sql_arquivos.sql.Add('WHERE TIPO = 2 ');

modulo.sql_arquivos.ExecSQL();

// essa query é necessaria porque depois que faz um delete a sql não aceita um append

modulo.cds_arquivos.close;

modulo.sql_arquivos.sql.clear;

modulo.sql_arquivos.sql.Add('SELECT * FROM ARQUIVOS ');

modulo.sql_arquivos.sql.Add('WHERE TIPO = 2 ');

modulo.cds_arquivos.Open();

if FindFirst(caminho+'*.pdf', faAnyFile, searchResult) = 0 then

begin

repeat

// incrementa a barra de progresso

aguarde.Frmaguarde.progresso.Position := aguarde.Frmaguarde.progresso.Position + 1;

if aguarde.Frmaguarde.progresso.Position = 100 then

aguarde.Frmaguarde.progresso.Position := 1;

if (searchResult.Name <> '.') AND (searchResult.Name <> '..') then

begin

// desenhos tipo = 2

codigo := codigo + 1;

modulo.CDS_arquivos.Append;

modulo.cds_arquivosCOD_ARQ.Value := codigo;

modulo.cds_arquivosNOME_ARQ.Value := searchResult.Name;

modulo.cds_arquivosTIPO.Value := 2;

modulo.cds_arquivos.post;

end;

until FindNext(searchResult) <> 0;

FindClose(searchResult);

frmaguarde.Close;

ShowMessage ('Atualização efetuada com sucesso');

end;

end;

essa rotina faz o seguinte quando eu clico ele ve o Speed botoon que esta precionado e executa essa rotina

com o caminho que eu passar

ela apaga td que tem no banco depois vai no caminho que eu passei por exemplo (C:\Teste)

pega o nome do arquivo e salva o nome no banco e fica no while ate acabar

só que essa rotina é pesada porque tem uns 2000 arquivos e salva no banco da rede compreende

e tem outros processos que eu preciso fazer isso mais se você me ajudar nessa já consigo andar com a proprias pernas depois

muito obrigado pela ajuda valeu mesmo

abraços

[Churc]

Opa

um exemplo

type
  TClearDB = class(TThread)
  private
  protected
    procedure Execute; override;
    procedure ClearDB;
  end;

...

procedure TClearDB.ClearDB;
begin
  with NomedoForm do
  begin
    if SBDesenhos.Down = true then 
    begin
      // delete tudo da tabela
      modulo.cds_arquivos.close;
      modulo.sql_arquivos.sql.clear;
      modulo.sql_arquivos.sql.Add('DELETE FROM ARQUIVOS ');
      modulo.sql_arquivos.sql.Add('WHERE TIPO = 2 ');
      modulo.sql_arquivos.ExecSQL();
    end;
  end;
end;

procedure TClearDB.Execute;
begin
  FreeOnTerminate := True; //limpa da memória ao finalizar
  Synchronize(ClearDB);  //faz a limpeza do banco de dados sem travar o programa
end;

procedure TForm1.Button1Click....
var
  ClearDB: TClearDB;
begin
  //o False indica que a thread sera iniciada assim q ela for criada...
  //se colocar True, depois só chamar ClearDB.Resume pra iniciá-la
  ClearDB := TClearDB.Create(False); 
end;

De uma olhada neste tópico também...

http://scriptbrasil.com.br/forum/index.php?showtopic=136897

entendeu?

abrxxx

Editado Maio 18, 2009 por Churc

[danielrgoes]

Opa

um exemplo

type
  TClearDB = class(TThread)
  private
  protected
    procedure Execute; override;
    procedure ClearDB;
  end;

...

procedure TClearDB.ClearDB;
begin
  with NomedoForm do
  begin
    if SBDesenhos.Down = true then 
    begin
      // delete tudo da tabela
      modulo.cds_arquivos.close;
      modulo.sql_arquivos.sql.clear;
      modulo.sql_arquivos.sql.Add('DELETE FROM ARQUIVOS ');
      modulo.sql_arquivos.sql.Add('WHERE TIPO = 2 ');
      modulo.sql_arquivos.ExecSQL();
    end;
  end;
end;

procedure TClearDB.Execute;
begin
  FreeOnTerminate := True; //limpa da memória ao finalizar
  Synchronize(ClearDB);  //faz a limpeza do banco de dados sem travar o programa
end;

procedure TForm1.Button1Click....
var
  ClearDB: TClearDB;
begin
  //o False indica que a thread sera iniciada assim q ela for criada...
  //se colocar True, depois só chamar ClearDB.Resume pra iniciá-la
  ClearDB := TClearDB.Create(False); 
end;

De uma olhada neste tópico também...

http://scriptbrasil.com.br/forum/index.php?showtopic=136897

entendeu?

abrxxx

Churc primeiro de td muito obrigado mesmo pela ajuda você da dando uma força imensa

depois eu ate entendi mais nesse caso você esta colocando o delete na threand

o meu problema esta na repetiçao no until porque ele repeti muitas vezes 2500 ai eu não posso mais mexer em nada que trava

ve se eu entendi direito

abraços

[Churc]

Daniel, então basta você adaptar os códigos, exemplo...

Fiz no Bloco de Notas então talvez tenha algum erro rs

Mas é pra você ter uma idéia :)

TEnumPDF = class(TThread)
  private
    iProgress: Integer;
    iMax: Integer;
  protected
    procedure ShowProgress;
    procedure EnumFiles;
    procedure Add2DB;
    procedure Execute; override;
  end;

var
  slBuff: TStringList;

implementation

procedure EnumFiles(szPath, szAllowedExt: String; iAttributes: Integer;
  Buffer: TStrings; bClear, bIncludePath: Boolean);
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 TEnumPDF.ShowProgress;
begin
  with aguarde.FrmAguarde do
  begin
    Progresso.Max := iMax;
    Progresso.Position := iProgress;
    if Progresso = iMax then
    begin
      Progresso.Position := 1;
      Close;
    end;
  end;
end;

procedure TEnumPDF.Add2DB;
var
  i: Integer;
begin
  iMax := slBuff.Count;
  for i := 0 to Pred(slBuff.Count) do
  begin
    // desenhos tipo = 2
    codigo := codigo + 1;
    modulo.CDS_arquivos.Append;
    modulo.cds_arquivosCOD_ARQ.Value := codigo;
    modulo.cds_arquivosNOME_ARQ.Value := slBuff[i];
    modulo.cds_arquivosTIPO.Value := 2;
    modulo.cds_arquivos.post;
    iProgress := i + 1;
    Synchronize(ShowProgress);
  end;
end;
  
end;

procedure TEnumPDF.Execute;
var
  i: 
begin
  FreeOnTerminate := True;

  if slBuff = nil then
  slBuff := TStringList.Create;

  try
    EnumFiles(caminho, '*.pdf', faAnyFile - faDirectory, slBuff, False, False);
  finally
    Synchronize(Add2DB);
  end;
  
  FreeAndNil(slBuff);
end;

procedure TForm1.Button1Click....
var
  EnumPDF: TEnumPDF;
begin
  EnumPDF := TEnumPDF.Create(False);
end;

veja se da certo

abrxx

[danielrgoes]

Bom dia Churc

antes de mais nada muito obrigado pela ajuda você deu uma força e tanto

estou aprendendo mais de thread para inplementar pois tem varias coisas aki que precisam disso

qualquer coisa eu corro aki atrz de você hahahhahah

muito obrigado mais uma vez

abraços

[William - TI]

Amigo estive dando uma olhada já tive esta duvida o que resolvel para o meu sistema foi espalhar este codigo pelas linhas de codigos

Application.ProcessMessages;

tipo :

while not query1.eof do begin

//funcoes..

query1.next;

Application.ProcessMessages;

end;

isto deve resolver seu problema.

[danielrgoes]

Amigo estive dando uma olhada já tive esta duvida o que resolvel para o meu sistema foi espalhar este codigo pelas linhas de codigos

Application.ProcessMessages;

tipo :

while not query1.eof do begin

//funcoes..

query1.next;

Application.ProcessMessages;

end;

isto deve resolver seu problema.

Willian

A dica parece ser muito boa

mais não entendi muito bem

poderia me dar mais explicaçoes

pois o que resolveu o problema deu alguns problemas em outras coisas

abraços

[Douglas Soares]

Deu Problema em outras coisas?, expecifique, que erro deu agora?, o que aconteceu?

Abraços!