Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

quinta-feira, 2 de outubro de 2014

DELPHI - Pegar Handle da Aplicação pelo nome do Executavel - Catch Handle Application by exe name

Reações: 
Parecido com o FindWindow, porém mais decente:

Unit:
 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  iListOfProcess : Integer;
  FHandle : Cardinal;
  FHWND   : HWND;
  FTaskName : String;
  FPid : DWORD;
  FProcessa : Boolean;  
implementation

{$R *.dfm}


function GetWindowPID(sFile: String): Cardinal;
var
  verSystem: TOSVersionInfo;
  hdlSnap,hdlProcess, AhdlProcess: THandle;
  bPath,bLoop: Bool;
  peEntry: TProcessEntry32;
  arrPid: Array [0..1023] of DWORD;
  iC: DWord;
  k,iCount: Integer;
  arrModul: Array [0..299] of Char;
  hdlModul: HMODULE;
  xHWND : HWND;

begin
  Result := 0;
  if ExtractFileName(sFile)=sFile then
    bPath:=false
  else
    bPath:=true;

  verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
  GetVersionEx(verSystem);
  if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then
  begin
    EnumProcesses(@arrPid,SizeOf(arrPid),iC);
    iCount := iC div SizeOf(DWORD);
    for k := 0 to Pred(iCount) do
    begin
      hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]);
      xHWND := hwnd(hdlProcess);
      if (hdlProcess<>0) then
      begin
        EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);
        GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));
        if bPath then
        begin
          if CompareText(arrModul,sFile) = 0 then
          begin
            Result := arrPid[k];
          end;
        end else
        begin
          if CompareText(ExtractFileName(arrModul),sFile) = 0 then
          begin
            Result := arrPid[k];
          end;
        end;
        CloseHandle(hdlProcess);
      end;
    end;
  end;
end;

function EnumProcess(hHwnd: HWND; lParam : integer): boolean; stdcall;
var
  pPid : DWORD;
  title, ClassName, Extra : string;
  AHWND : HWND;
begin
try
  if not FProcessa then Exit;
  FHWND := 0;
  //Se retornar nulo, cancela e sai
  if (hHwnd=NULL) then
  begin
    result := false;
  end
  else
  begin
    AHWND := hHWND;
    GetWindowThreadProcessId(hHwnd,pPid);
    //ClassName do Processo
    SetLength(ClassName, 255);
    SetLength(ClassName,
              GetClassName(hHwnd,
                           PChar(className),
                           Length(className)));
    if (pPid = FPid) and (UpperCase(className) = UpperCase('TApplication')) then
    begin
      FHWND := AHWND;
      FProcessa := False;
      Result := true;
      Abort;
    end;
    Result := true;
  end;
except
end;
end;

function GetTaskHandle(ATaskName : string) : HWND;
var
  hHwnd : HWND;
begin
  if Trim(ATaskName) <> '' then
  begin
    FTaskName := ATaskName;
    FPid := GetWindowPID(ATaskName);
    FProcessa := True;
    if not EnumWindows(@EnumProcess, iListOfProcess) then
      exit
    else
      Application.ProcessMessages;

    Result := FHWND;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  cExeName = 'C:\temp\Project1.exe';
begin
  Self.Caption := 'PID: "' + cExeName + '" ' +
                  InttoStr(GetWindowPID(cExeName)) + ' - ' +
                  InttoStr(GetTaskHandle(cExeName));
end;

end.

Nenhum comentário:

Postar um comentário

Observação: somente um membro deste blog pode postar um comentário.

Max Gehringer