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

[douglaspr]

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 :)

[Jhonas]

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

[douglaspr]

O erro que acontece é "Access Violation" em function SysGetMem(Size: NativeInt): Pointer;

{Set the block header}

mov [eax - 4], edx

Compilador: Delphi XE3

[Jhonas]

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

[douglaspr]

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);

[Jhonas]

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

[douglaspr]

Se eu uso o código do heuristico em sí direto na thread entre os "labels" também ocorre o crash.

já usei synchonize e também acontece a mesma coisa.

[Jhonas]

pelo seu código, a finalidade seria a de fechar uma janela, caso o nome dela esteja na sua lista ?

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

[douglaspr]

Não apenas isso, se você observar o código inteiro verá que ele pega todos textos da tela, e fecha através da Pos verificando com minha lista.

e não apenas um PostMessage(FindWindow(nil, Caption), WM_Close, 0, 0);

Editado Janeiro 30, 2013 por douglaspr

[Jhonas]

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

[douglaspr]

Essa função também causa crash na aplicação se usada a thread com delay baixo.

[Jhonas]

experimente usa-la sozinha ( fora da Thread ), se funcionar o problema então esta na Thread

abraço

[douglaspr]

Não está na thread pois tenho mais 2 threads que chamam outras funções e funciona normalmente.

Teste você mesmo, com a thread que coloquei acima e verá.

Editado Fevereiro 2, 2013 por douglaspr

[Jhonas]

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

[douglaspr]

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)

[Jhonas]

coloque o codigo completo para poder analizar

[douglaspr]

é esse ai, só faltou o procedure Heuristico; encima do var.

[Jhonas]

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

[douglaspr]

Seu codigo não permanece em execução, tem que ficar clicando no botão -.-'

[Jhonas]

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

[douglaspr]

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

[Jhonas]

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

[douglaspr]

já tentei com TThread, timer e SetTimer e ocorre a mesmo coisa.

[Jhonas]

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