Ir para conteúdo
Fórum Script Brasil
  • 0

Código causando crash na aplicação + Thread

douglaspr

Perguntado por douglaspr,

 Share

Pergunta

douglaspr

douglaspr

Postado
Postado

Boa tarde, estou com um problema ... tenho uma procedure que faz uma verificação heuristica, no caso ela pega todo texto que existe na tela e aplicações e verifica com um listbox pesquisando pela existencia de algum através da função "Pos".

Acontece que essa procedure está sendo chamada por uma Thread (CreateThread e GotoLabel) e quando uso um delay (Sleep) baixo ela causa crash na aplicação.

Já tentei ao maximo resolver porém sem resultados positivos até agora, se alguém souber como me ajudar agradeço.

Segue a procedure:

procedure Heuristico;
var
  Idx     : Word;
  X       : Word;
  Caption : Array[0..255] of Char;
begin
  for Idx := 0 to ListaHeur.Count-1 do begin
    Application.ProcessMessages;
    for X:=1 to 10000 do begin
    Application.ProcessMessages;
      if (GetWindowText(x,Caption,255) <> 0) then begin
      Application.ProcessMessages;
        if Caption <> '' then begin
        Application.ProcessMessages;
          if (Pos(AnsiLowerCase(ListaHeur.Strings[Idx]), AnsiLowerCase(Caption)) > 0) then begin
            detectado := true;

            PostMessage(FindWindow(nil, Caption), WM_Close, 0, 0);

            CriaLog('null','null', Caption);

            break;
          end;
          Application.ProcessMessages;
        end;
        Application.ProcessMessages;
      end;
      Application.ProcessMessages;
    end;
    Application.ProcessMessages;
  end;

  Application.ProcessMessages;
end;

Grato a todos :)

Link para o comentário
Compartilhar em outros sites

23 respostass a esta questão

Posts Recomendados

  • 0
Jhonas

Jhonas

Postado
Postado

seja sempre mais explicito com relação ao erro ( ela causa crash na aplicação.) ... coloque a mensagem de erro que ocorre.

sempre tenha cuidado em usar a instrução: Application.ProcessMessages;

uma de suas aplicações é justamente dar uma pausa na execução para verificar outras funções pendentes...

exemplo de uso correto:

procedure Heuristico;
var
  Idx     : Word;
  X       : Word;
  Caption : Array[0..255] of Char;
begin
  for Idx := 0 to ListaHeur.Count-1 do begin
    for X:=1 to 10000 do begin
      if (GetWindowText(x,Caption,255) <> 0) then begin
        if Caption <> '' then begin
          if (Pos(AnsiLowerCase(ListaHeur.Strings[Idx]), AnsiLowerCase(Caption)) > 0) then begin
            detectado := true;

            PostMessage(FindWindow(nil, Caption), WM_Close, 0, 0);

            CriaLog('null','null', Caption);

            break;
          end;
        end;
      end;
    end;
  end;
  Application.ProcessMessages;
end;

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

violação de acesso, ocorre quando uma posição de memoria já esta ocupada e uma instrução tenta gravar alguma informação nessa posição.

experimente usar a procedure sem usar o sleep ( já que voce esta usando Thread )

e procure usar o debugger com o breakpoint para verificar a sequencia do código

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
douglaspr

douglaspr

Postado
  • Autor
Postado

Sem sleep a aplicação causa crash instantaneamente após iniciar ...

segue minha thread:

procedure PSDRun2(Inicialize: Pointer);
Label
  GoToLabel;
begin
  if not detectado then begin

  GoToLabel :

  { Heuristico }

  Heuristico;


  GoTo GoToLabel;

  end;
end;

e

CreateThread(nil, 0, @PSDRun2, Pointer(nil), 0, ThreadId2);

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

veja a resposta:

violação de acesso, ocorre quando uma posição de memoria já esta ocupada e uma instrução tenta gravar alguma informação nessa posição.

o problema esta na sua thread

procedure PSDRun2(Inicialize: Pointer);
Label
  GoToLabel;
begin
  if not detectado then begin

  GoToLabel :

  { Heuristico }

  Heuristico;


  GoTo GoToLabel;

  end;
end;

o tempo de chamada do GoToLabel está mais rapido do que o processamento do Heuristico

use o breakpoint para acompanhar o processamento e descobrirá onde esta o problema

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

então faça uma adaptação do seu código com esse 

function FecharJanela(Nome: String):String;
var
X: Word;
H: THandle;
Caption: Array[0..255] of Char;
begin
for X:=1 to 10000 do
begin
if((GetWindowText(x,Caption,255)<>0)and (GetWindowLong(x,GWL_EXSTYLE)<>0)and
(GetWindowLong(x,GWL_HWNDPARENT)=0)and (GetWindowLong(x,GWL_HINSTANCE)<>0))then
if(IsWindowVisible(x))then
if(pos(Nome,Caption)>0) then
begin
H:=FindWindow(nil,Caption);
SendMessage(H,WM_CLOSE,0,0);
end;
end;
end;

// modo de uso

FecharJanela('Bloco');

obs: altere esse código para receber a sua lista

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

Fiz um teste aqui e funciona perfeitamente

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

function FecharJanela(Nome: String):String;
var
   X: Word;
   H: THandle;
   Caption: Array[0..255] of Char;
begin

   for X:=1 to 10000 do
   begin
      if((GetWindowText(x,Caption,255)<>0)and (GetWindowLong(x,GWL_EXSTYLE)<>0)and
        (GetWindowLong(x,GWL_HWNDPARENT)=0)and (GetWindowLong(x,GWL_HINSTANCE)<>0))then
        if(IsWindowVisible(x))then
           if(pos(Nome,Caption)>0) then
              begin
                H:=FindWindow(nil,Caption);
                SendMessage(H,WM_CLOSE,0,0);
              end;
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin

   for I := 0 to ListBox1.Count-1 do
      FecharJanela(ListBox1.Items.Strings[i]);
end;

end.

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
douglaspr

douglaspr

Postado
  • Autor
Postado

Teste assim:

var
  Idx     : DWord;
begin
  //if not detectado then begin
    Application.ProcessMessages;

    for Idx := 0 to ListaHeur.Count-1 do begin
      //Delay(10);

      FecharJanela(ListaHeur.Strings[Idx]);

      //Delay(10);
    end;
  //end;
end;

function PSDRun3(Inicialize: Pointer):Dword;stdcall;
Label
  GoToLabel;
begin
  //if not detectado then begin

  GoToLabel :

    { Heuristico }

    Heuristico;

    //Result := 0;

  GoTo GoToLabel;

  //end;
end;

CreateThread(nil, 0, @PSDRun3, Pointer(nil), NORMAL_PRIORITY_CLASS, ThreadId3)

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

seria assim a maneira de fazer .... faça as modificações necessarias para o seu uso

unit Unit1;

interface

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

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

var
  Form1: TForm1;
  hThread : THandle;

implementation

{$R *.dfm}

Function StartThread(pFunction : TFNThreadStartRoutine; iPriority : Integer = Thread_Priority_Normal; iStartFlag : Integer = 0) : THandle;
var
   ThreadID : DWORD;
begin
   Result := CreateThread(nil, 0, pFunction, nil, iStartFlag, ThreadID);
   if Result <> Null then
      SetThreadPriority(Result, iPriority);
end;

Function CloseThread( ThreadHandle : THandle) : Boolean;
begin
   Result := TerminateThread(ThreadHandle, 1);
   CloseHandle(ThreadHandle);
end;

function FecharJanela(Nome: String):String;
var
   X: Word;
   H: THandle;
   Caption: Array[0..255] of Char;
begin

   for X:=1 to 10000 do
   begin
      if((GetWindowText(x,Caption,255)<>0)and (GetWindowLong(x,GWL_EXSTYLE)<>0)and
        (GetWindowLong(x,GWL_HWNDPARENT)=0)and (GetWindowLong(x,GWL_HINSTANCE)<>0))then
        if(IsWindowVisible(x))then
           if(pos(Nome,Caption)>0) then
              begin
                H:=FindWindow(nil,Caption);
                SendMessage(H,WM_CLOSE,0,0);
              end;
   end;

end;


procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
//Label
//  GoToLabel;
begin
//   GoToLabel :

   hThread := StartThread(@FecharJanela);

   hThread := StartThread(@FecharJanela,THREAD_PRIORITY_NORMAL);

   for I := 0 to ListBox1.Count-1 do
      FecharJanela(ListBox1.Items.Strings[i]);

   Application.ProcessMessages;

//   GoTo GoToLabel;

   CloseThread(hThread);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Application.ProcessMessages;
   CloseThread(hThread);
end;

end.

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

por isso escrevi ... faça as modificações necessarias para o seu uso

se quer que fique em loop basta fazer isso

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
Label
  GoToLabel;
begin
   GoToLabel :

   hThread := StartThread(@FecharJanela);

   hThread := StartThread(@FecharJanela,THREAD_PRIORITY_NORMAL);

   for I := 0 to ListBox1.Count-1 do
      FecharJanela(ListBox1.Items.Strings[i]);

   Application.ProcessMessages;

   GoTo GoToLabel;

   //CloseThread(hThread);

end;

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

Se você testou você viu que da crash na aplicação, o seu código

amigo, estou tentando mostrar a voce onde esta o erro ... voce percebeu que ao usar o comando GoTo GoToLabel;

ocorre o erro .... então voce tem que pensar em alguma outra forma para manter a sua Thread funcionando

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

mesmo usando um timer, voce verá que é necessario dar um tempo para a execução da função ... esse tempo depende do processador do micro ( pode ser maior ou menor esse tempo de espera, até a finalização da sua lista )

uma sugestão se voce usar um timer:

ao inicar o procedimento, voce desabilita o timer .... ao finalizar a sua lista, voce habilita novamente o timer ...é por ai

abraço

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...