I use a global CBT hook to recognize windows setfocus messages.
When keyboard focus changes, I want my application to notice that.
Therefore, I store the handle of my application using memory mapped files so that every process can use it for sending a message to the application after the focus changed.
I used 32-bit windows as target platform in both the hook.dll and the application.
Now, as far as I know, 32 bit processes should be hooked and 64 bit processes should be ignored. On a 32 bit system, the application works great.
When it is used it on a 64 bit windows, it also works in 32 bit processes (e.g. the delphi IDE),
but sometimes the application freezes.
for example when I start the internet explorer.
I noticed that there is a 32 bit and a 64 bit iexplore.exe in the task manager when Internet Explorer is running.
Could this be the problem? I don't understand why 64 bit processes are not simply ignored... Please help!
Below is the code of the hook.dll which is called by the main application:
library Project1;
uses
{System.SysUtils,
System.Classes,
sharemem,
windows,
messages,}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants;
const
WM_MYFOCUSCHANGED = WM_USER + 1;
type
PHookRec = ^THookRec;
THookRec = packed Record
HookHandle: hhook;
WindowHandle: hwnd;
End;
var
MapHandle: THandle; // File Mapping Objekt
IpHookRec: PHookRec; // Zeiger auf Hook Record
{$R *.res}
procedure MapFileMemory(dwAllocSize: DWORD);
begin
{Create a process wide memory mapped variable}
MapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, dwAllocSize, 'HookRecMemBlock');
if (MapHandle = 0) then
begin
MessageBox(0, 'Hook DLL', 'Could not create file map object', MB_OK);
exit;
end;
{Get a pointer to our process wide memory mapped variable}
ipHookRec := MapViewOfFile(MapHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
if (ipHookRec = nil) then
begin
CloseHandle(MapHandle);
MessageBox(0, 'Hook DLL', 'Could not map file', MB_OK);
exit;
end;
end;
procedure UnMapFileMemory;
begin
{Delete our process wide memory mapped variable}
if (ipHookRec <> nil) then
begin
UnMapViewOfFile(ipHookRec);
ipHookRec := nil;
end;
if (MapHandle > 0) then
begin
CloseHandle(MapHandle);
MapHandle := 0;
end;
end;
function GetHookRecPointer: pointer stdcall;
begin
{Return a pointer to our process wide memory mapped variable}
result := ipHookRec;
end;
function FocusHookProc(code: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
begin
if (code < 0) then
begin
result := CallNextHookEx(ipHookRec^.HookHandle, code, wParam, lParam);
exit;
end;
result := 0;
if (code = HCBT_SETFOCUS) then
begin
if (ipHookRec^.WindowHandle <> INVALID_HANDLE_VALUE) then
PostMessage(ipHookRec^.WindowHandle, WM_MYFOCUSCHANGED, wParam, lParam);
// wParam: Handle to the window gaining the keyboard focus
end;
end;
procedure InstallHook(Hwnd: Cardinal); stdcall;
begin
if ((ipHookRec <> nil) and (ipHookRec^.HookHandle = 0) and (ipHookRec^.WindowHandle = 0)) then
begin
ipHookRec^.WindowHandle := Hwnd; // handle to the application window
ipHookRec^.HookHandle := SetWindowsHookEx(WH_CBT, #FocusHookProc, Hinstance, 0);
end;
end;
procedure UninstallHook; stdcall;
begin
if ((ipHookRec <> nil) and (ipHookRec^.HookHandle <> 0)) then
begin
{Remove our hook and clear our hook handle}
if (UnHookWindowsHookEx(ipHookRec^.HookHandle) <> FALSE) then
begin
ipHookRec^.HookHandle := 0;
ipHookRec^.WindowHandle := 0;
end;
end;
end;
procedure DllEntryPoint(dwReason: DWORD);
var
currHwnd: Hwnd;
is64: Boolean;
begin
case dwReason of
Dll_Process_Attach:
begin
{If we are getting mapped into a process, then get a pointer to our
process wide memory mapped variable}
MapHandle := 0;
ipHookRec := nil;
MapFileMemory(sizeof(ipHookRec^));
end;
Dll_Process_Detach:
begin
{If we are getting unmapped from a process then, remove the pointer to
our process wide memory mapped variable}
UnMapFileMemory;
end;
end;
end;
exports
InstallHook name 'INSTALLHOOK',
UninstallHook name 'UNINSTALLHOOK',
GetHookRecPointer name 'GETHOOKRECPOINTER';
begin
DLLProc := #DllEntryPoint; // set DLL main entry point
DllEntryPoint(Dll_Process_Attach); // call DLL main entry point
end.
Your 32 bit hook will not be loaded into a 64 bit process. This means that your problem is likely elsewhere.
Related
I want my delphi application to be able to know which control currently has keyboard focus, system wide (in different processes).
To achieve this, I use a global CBT hook to get all of the setfocus messages. Every focus change triggers my application to check the type of the focused control by using UIAutomation framework.
This works e.g. for my own delphi applications or in the delphi IDE, but if I focus edit boxes in chrome browser, I will only get the window and not the focused control. Changing focus inside of chrome window has no effect. There's no setfocus message sent anymore.
Furthermore, focusing e.g. the edit box in the start menu of windows or elements in the explorer won't return anything.
As far as I know, those actions should also cause a setfocus message, so I think that maybe not every process is hooked properly.
Below is the code of my hook DLL, I don't know what I am doing wrong...
const
WM_MYFOCUSCHANGED = WM_USER + 1;
type
PHookRec = ^THookRec;
THookRec = packed Record
HookHandle: hhook;
WindowHandle: hwnd;
End;
var
MapHandle: THandle; // file mapping object
ipHookRec: PHookRec; // Pointer to hook record
{$R *.res}
procedure MapFileMemory(dwAllocSize: DWORD);
begin
{Create a process wide memory mapped variable}
MapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, dwAllocSize, 'HookRecMemBlock');
if (MapHandle = 0) then
begin
MessageBox(0, 'Hook DLL', 'Could not create file map object', MB_OK);
exit;
end;
{Get a pointer to our process wide memory mapped variable}
ipHookRec := MapViewOfFile(MapHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
if (ipHookRec = nil) then
begin
CloseHandle(MapHandle);
MessageBox(0, 'Hook DLL', 'Could not map file', MB_OK);
exit;
end;
end;
procedure UnMapFileMemory;
begin
{Delete our process wide memory mapped variable}
if (ipHookRec <> nil) then
begin
UnMapViewOfFile(ipHookRec);
ipHookRec := nil;
end;
if (MapHandle > 0) then
begin
CloseHandle(MapHandle);
MapHandle := 0;
end;
end;
function GetHookRecPointer: pointer stdcall;
begin
{Return a pointer to our process wide memory mapped variable}
result := ipHookRec;
end;
function FocusHookProc(code: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
begin
if (code < 0) then
begin
result := CallNextHookEx(ipHookRec^.HookHandle, code, wParam, lParam);
exit;
end;
result := 0;
if (code = WM_SETFOCUS) then
begin
if (ipHookRec^.WindowHandle <> INVALID_HANDLE_VALUE) then
PostMessage(ipHookRec^.WindowHandle, WM_MYFOCUSCHANGED, wParam, lParam);
// wParam: Handle to the window gaining keyboard focus
end;
end;
procedure InstallHook(Hwnd: Cardinal); stdcall;
begin
if ((ipHookRec <> nil) and (ipHookRec^.HookHandle = 0) and (ipHookRec^.WindowHandle = 0)) then
begin
ipHookRec^.WindowHandle := Hwnd; // handle to the application window
ipHookRec^.HookHandle := SetWindowsHookEx(WH_CBT, #FocusHookProc, Hinstance, 0);
end;
end;
procedure UninstallHook; stdcall;
begin
if ((ipHookRec <> nil) and (ipHookRec^.HookHandle <> 0)) then
begin
{Remove our hook and clear our hook handle}
if (UnHookWindowsHookEx(ipHookRec^.HookHandle) <> FALSE) then
begin
ipHookRec^.HookHandle := 0;
ipHookRec^.WindowHandle := 0;
end;
end;
end;
procedure DllEntryPoint(dwReason: DWORD);
begin
case dwReason of
Dll_Process_Attach:
begin
{If we are getting mapped into a process, then get a pointer to our
process wide memory mapped variable}
MapHandle := 0;
ipHookRec := nil;
MapFileMemory(sizeof(ipHookRec^));
end;
Dll_Process_Detach:
begin
{If we are getting unmapped from a process then, remove the pointer to
our process wide memory mapped variable}
UnMapFileMemory;
end;
end;
end;
exports
InstallHook name 'INSTALLHOOK',
UninstallHook name 'UNINSTALLHOOK',
GetHookRecPointer name 'GETHOOKRECPOINTER';
begin
DLLProc := #DllEntryPoint; // set DLL main entry point
DllEntryPoint(Dll_Process_Attach); // call DLL main entry point
end.
I have a server written in Delphi that I would like to add a debug logger to so it can log messages passed to Windows.OutputDebugString() while it is deployed, so clients can send me the log when there are issues. In the end, I want functionality similar to DebugView, but built into the server program itself.
I understand how the OutputDebugString works by writing to a shared memory file and using system wide events to synchronize the program and its debugger, and I have found solutions in C# and C++, but have yet to be able to translate those solutions to Delphi.
My largest problem is not knowing how to interact with the DBWIN_BUFFER_READY and DBWIN_DATA_READY synchronization events with Delphi, or how to reference the specific memory mapped file "DBWIN_BUFFER" that OutputDebugString writes to.
Additionally I have found solutions that implement their own method call instead of Windows.OutputDebugString(), but the program already has hundreds of calls, both in the code we have written and third-party modules we have added in, so these are not an option.
The C++ code you linked to can be translated to Delphi as follows:
//////////////////////////////////////////////////////////////
//
// File: WinDebugMonitor.pas
// Description: Interface of class TWinDebugMonitor
// Created: 2007-12-6
// Author: Ken Zhang
// E-Mail: cpp.china#hotmail.com
//
// Translated: 2015-02-13
// Translator: Remy Lebeau
// E-Mail: remy#lebeausoftware.org
//
//////////////////////////////////////////////////////////////
unit WinDebugMonitor;
interface
uses
Windows;
type
PDbWinBuffer = ^DbWinBuffer;
DbWinBuffer = record
dwProcessId: DWORD;
data: array[0..(4096-sizeof(DWORD))-1] of AnsiChar;
end;
TWinDebugMonitor = class
private
m_hDBWinMutex: THandle;
m_hDBMonBuffer: THandle;
m_hEventBufferReady: THandle;
m_hEventDataReady: THandle;
m_hWinDebugMonitorThread: THandle;
m_bWinDebugMonStopped: Boolean;
m_pDBBuffer: PDbWinBuffer;
function Initialize: DWORD;
procedure Uninitialize;
function WinDebugMonitorProcess: DWORD;
public
constructor Create;
destructor Destroy; override;
procedure OutputWinDebugString(const str: PAnsiChar); virtual;
end;
implementation
// ----------------------------------------------------------------------------
// PROPERTIES OF OBJECTS
// ----------------------------------------------------------------------------
// NAME | DBWinMutex DBWIN_BUFFER_READY DBWIN_DATA_READY
// ----------------------------------------------------------------------------
// TYPE | Mutex Event Event
// ACCESS | All All Sync
// INIT STATE | ? Signaled Nonsignaled
// PROPERTY | ? Auto-Reset Auto-Reset
// ----------------------------------------------------------------------------
constructor TWinDebugMonitor.Create;
begin
inherited;
if Initialize() <> 0 then begin
OutputDebugString('TWinDebugMonitor.Initialize failed.'#10);
end;
end;
destructor TWinDebugMonitor.Destroy;
begin
Uninitialize;
inherited;
end;
procedure TWinDebugMonitor.OutputWinDebugString(const str: PAnsiChar);
begin
end;
function WinDebugMonitorThread(pData: Pointer): DWORD; stdcall;
var
_Self: TWinDebugMonitor;
begin
_Self = TWinDebugMonitor(pData);
if _Self <> nil then begin
while not _Self.m_bWinDebugMonStopped do begin
_Self.WinDebugMonitorProcess;
end;
end;
Result := 0;
end;
function TWinDebugMonitor.Initialize: DWORD;
begin
SetLastError(0);
// Mutex: DBWin
// ---------------------------------------------------------
m_hDBWinMutex := OpenMutex(MUTEX_ALL_ACCESS, FALSE, 'DBWinMutex');
if m_hDBWinMutex = 0 then begin
Result := GetLastError;
Exit;
end;
// Event: buffer ready
// ---------------------------------------------------------
m_hEventBufferReady := OpenEvent(EVENT_ALL_ACCESS, FALSE, 'DBWIN_BUFFER_READY');
if m_hEventBufferReady = 0 then begin
m_hEventBufferReady = CreateEvent(nil, FALSE, TRUE, 'DBWIN_BUFFER_READY');
if m_hEventBufferReady = 0 then begin
Result := GetLastError;
Exit;
end;
end;
// Event: data ready
// ---------------------------------------------------------
m_hEventDataReady := OpenEvent(SYNCHRONIZE, FALSE, 'DBWIN_DATA_READY');
if m_hEventDataReady = 0 then begin
m_hEventDataReady := CreateEvent(nil, FALSE, FALSE, 'DBWIN_DATA_READY');
if m_hEventDataReady = 0 then begin
Result := GetLastError;
end;
end;
// Shared memory
// ---------------------------------------------------------
m_hDBMonBuffer := OpenFileMapping(FILE_MAP_READ, FALSE, 'DBWIN_BUFFER');
if m_hDBMonBuffer = 0 then begin
begin
m_hDBMonBuffer := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(DbWinBuffer), 'DBWIN_BUFFER');
if m_hDBMonBuffer = 0 then begin
Result := GetLastError;
Exit;
end;
end;
m_pDBBuffer := PDbWinBuffer(MapViewOfFile(m_hDBMonBuffer, SECTION_MAP_READ, 0, 0, 0));
if m_pDBBuffer = nil then begin
Result := GetLastError;
Exit;
end;
// Monitoring thread
// ---------------------------------------------------------
m_bWinDebugMonStopped := False;
m_hWinDebugMonitorThread := CreateThread(nil, 0, #WinDebugMonitorThread, Self, 0, nil);
if m_hWinDebugMonitorThread = 0 then begin
m_bWinDebugMonStopped := True;
Result := GetLastError;
Exit;
end;
// set monitor thread's priority to highest
// ---------------------------------------------------------
SetPriorityClass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS);
SetThreadPriority(m_hWinDebugMonitorThread, THREAD_PRIORITY_TIME_CRITICAL);
Result := 0;
end;
procedure TWinDebugMonitor.Uninitialize;
begin
if m_hWinDebugMonitorThread <> 0 then begin
m_bWinDebugMonStopped := True;
WaitForSingleObject(m_hWinDebugMonitorThread, INFINITE);
CloseHandle(m_hWinDebugMonitorThread);
m_hWinDebugMonitorThread := 0;
end;
if m_hDBWinMutex <> 0 then begin
CloseHandle(m_hDBWinMutex);
m_hDBWinMutex := 0;
end;
if m_pDBBuffer <> nil then begin
UnmapViewOfFile(m_pDBBuffer);
m_pDBBuffer := nil;
end;
if m_hDBMonBuffer <> 0 then begin
CloseHandle(m_hDBMonBuffer);
m_hDBMonBuffer := 0;
end;
if m_hEventBufferReady <> 0 then begin
CloseHandle(m_hEventBufferReady);
m_hEventBufferReady := 0;
end;
if m_hEventDataReady <> 0 then begin
CloseHandle(m_hEventDataReady);
m_hEventDataReady := 0;
end;
end;
function TCWinDebugMonitor.WinDebugMonitorProcess: DWORD;
const
TIMEOUT_WIN_DEBUG = 100;
begin
// wait for data ready
Result := WaitForSingleObject(m_hEventDataReady, TIMEOUT_WIN_DEBUG);
if Result = WAIT_OBJECT_0 then begin
OutputWinDebugString(m_pDBBuffer^.data);
// signal buffer ready
SetEvent(m_hEventBufferReady);
end;
end;
program Monitor;
{$APPTYPE CONSOLE}
{$R *.res}
uses
WinDebugMonitor;
type
Monitor = class(TWinDebugMonitor)
public
procedure OutputWinDebugString(const str: PAnsiChar); override;
end;
procedure Monitor.OutputWinDebugString(const str: PAnsiChar);
begin
Write(str);
end;
var
mon: Monitor;
begin
WriteLn('Win Debug Monitor Tool');
WriteLn('----------------------');
mon := Monitor.Create;
try
ReadLn;
finally
mon.Free;
end;
end.
program Output;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils, Windows, Messages;
var
hConsoleInput: THandle;
function KeyPressed: boolean;
var
NumberOfEvents: Integer;
begin
GetNumberOfConsoleInputEvents(hConsoleInput, NumberOfEvents);
Result := NumberOfEvents > 0;
end;
procedure KeyInit;
var
mode: Integer;
begin
// get input file handle
Reset(Input);
hConsoleInput := TTextRec(Input).Handle;
// checks/sets so mouse input does not work
SetActiveWindow(0);
GetConsoleMode(hConsoleInput, mode);
if (mode and ENABLE_MOUSE_INPUT) = ENABLE_MOUSE_INPUT then
SetConsoleMode(hConsoleInput, mode xor ENABLE_MOUSE_INPUT);
end;
var
i: Integer;
buf: AnsiString;
begin
KeyInit;
WriteLn('Press any key to stop calling OutputDebugString......');
i := 0;
while not KeyPressed do
begin
Inc(i);
buf := Format('Message from process %d, msg id: %d'#10, [ GetCurrentProcessId(), I]);
OutputDebugStringA(PAnsiChar(buf));
end;
Writeln('Total ', i, ' messages sent.');
end.
Your solution is wrong.
Hint: This function is listed under functions for debugging, and it has "Debug" in its name.
Imagine what if two programs did this. OutputDebugString is a global function. It sends a string from ANY process to the debugger. If two programs would use OutputDebugString as their logging solution - you will get a mess from simultaneous output from two processes, and each log will be mixed with other.
Quote from MSDN (as additional proof that your solution is wrong):
Applications should send very minimal debug output and provide a way for the user to enable or disable its use. To provide more detailed tracing, see Event Tracing.
In other words, OutputDebugString is a debugging solution for development builds; it is not a logging system.
Use this (pseudo-code to illustrate the idea):
unit DebugTools;
interface
procedure OutputDebugString(const AStr: String);
implementation
procedure OutputDebugString(const AStr: String);
begin
if IsDebuggerPresent then
Windows.OutputDebugString(PChar(AStr))
else
begin
CritSect.Enter;
try
GlobalLog.Add(AStr);
finally
CritSect.Leave;
end;
end;
end;
end.
Just add this unit to the uses clause for each of your other units - and you will automatically capture "output OutputDebugString" without need to change source code.
Im trying to use SetWindowsHookEx to Hook Mouse in some process. Im using Delphi 7.
Code (DLL):
function MouseProc(code: integer; wParam: WPARAM; lParam: LPARAM)
: LongInt; stdcall;
var
AppWnd: HWND;
begin
Result := 0;
if (code < 0) then
Result := CallNextHookEx(HookHandle, code, wParam, lParam)
else begin
AppWnd := FindWindowW('ichookapplication', nil);
SendMessage(AppWnd, MW_MOUSEHOOKED, wParam, GetCurrentProcessId);
Result := CallNextHookEx(HookHandle, code, wParam, lParam);
end;
end;
procedure HookThreadId(theadId: Cardinal) export; stdcall;
var
e: DWORD;
begin
HookHandle := SetWindowsHookEx(WH_MOUSE, #MouseProc, 0, theadId);
if (HookHandle = 0) then
begin
e := GetLastError;
MessageBox(0, 'error', PAnsiChar(IntToStr(e)), MB_OK);
end;
end;
MW_MOUSEHOOKED is WM_USER + 101;
application:
//loading code
if (dll = 0) then
begin
dll := LoadLibrary('mhook.dll');
#Hook := nil;
#SetThreadHook := nil;
end;
if (dll > HINSTANCE_ERROR) then
begin
pH := GetProcAddress(dll, 'Hook');
#Hook := pH;
pSth := GetProcAddress(dll, 'HookThreadId');
#SetThreadHook := pSth;
end;
// attach code
h := FindWindow(nil, 'Form1');
terminalProc := GetWindowThreadProcessId(h, nil);
if (terminalProc = 0) then
begin
ShowMessage(IntToStr(GetLastError));
Exit;
end;
SetThreadHook(terminalProc);
So. SetWindowsHookEx returns 1428 error: Cannot set nonlocal hook without a module handle.
But as i know if im using dll hmodule is not needed...
How i whant it will work:
Every mouse event will passing to my app (window class is 'ichookapplication') using WM_DATA (wParam is event data, lParam is ProcessId)
Thanks!
WH_MOUSE is a global hook. The DLL will be injected into hooked processes. You do need to supply a module handle. The name associated with error code 1428 is pretty clear, ERROR_HOOK_NEEDS_HMOD. It's not as though it's difficult to provide a module handle. Pass HInstance.
If you don't want to inject, then you'll need to use WH_MOUSE_LL instead of WH_MOUSE.
I am developing an application in Delphi XE2 which inspects, through the functions EnumWindows and EnumChildWindows a window of a running application also written in Delphi.
This is the main code (adapted from an example: http://www.swissdelphicenter.ch/torry/showcode.php?id=410)
function EnumChildWindowsProc(Wnd: HWnd; Form: TForm1): Bool; export;
{$ifdef Win32} stdcall; {$endif}
var
Buffer: array[0..99] of Char;
begin
GetWindowText(Wnd, Buffer, 100);
if StrPas(Buffer) = '' then Buffer := 'Empty';
new(AWindows);
with AWindows^ do
begin
WindowHandle := Wnd;
WindowText := StrPas(Buffer);
end;
CNode := Form1.TreeView1.Items.AddChildObject(PNode,
AWindows^.WindowText + ':' +
IntToHex(AWindows^.WindowHandle, 8), AWindows);
if GetWindow(Wnd, GW_CHILD) = 0 then
begin
PNode := CNode;
Enumchildwindows(Wnd, #EnumChildWindowsProc, 0);
end;
Result := True;
end;
function EnumWindowsProc(Wnd: HWnd; Form: TForm1): Bool;
export; {$ifdef Win32} stdcall; {$endif}
var
Buffer: array[0..99] of Char;
begin
GetWindowText(Wnd, Buffer, 100);
if StrPas(Buffer) = '' then Buffer := 'Empty';
new(AWindows);
with AWindows^ do
begin
WindowHandle := Wnd;
WindowText := StrPas(Buffer);
end;
if Pos(Form1.edAppToFind.Text,AWindows^.WindowText) > 0 then // <- inspect child only for my Application
begin
PNode := Form1.TreeView1.Items.AddObject(nil, AWindows^.WindowText + ':' +
IntToHex(AWindows^.WindowHandle, 8), AWindows);
EnumChildWindows(Wnd, #EnumChildWindowsProc, 0);
end;
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(#EnumWindowsProc, self.Handle);
end;
Everything works well, except for the object TGroupBox after which the recursion stops. But control TGroupBox contains inside other elements (TLabel).
In fact, even writing a simple application in Delphi, by including in the Form a TGroupBox and then into the TGroupBox a TLabel, launching the Application and inspecting it with Spy++ (or with the Tool Autoit AU3Info) you can not enter into the TGroupBox: the TLabel inside is not inspected.
Is there a way to find TLabel control within the TGroupBox?
This is not an issue with the group box control. The issue is that the TLabel control is not windowed. There's no window handle associated with it and so it cannot be found by Spy++, EnumChildWindows etc.
I need determine when a process id (PID) is 32 or 64 bit application using delphi, how i can do that? I really check the IsWow64Process function but works with a process handle not a PID.
You can use the OpenProcess function to get a handle to the pid and then call the IsWow64Process function.
Remember that you must load the IsWow64Process function using the GetProcAddress function because some versions of Windows does not include this function.
Check this sample code
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils;
type
TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
IsWow64Process : TIsWow64Process;
procedure Init_IsWow64Process;
var
hKernel32 : Integer;
begin
hKernel32 := LoadLibrary(kernel32);
if (hKernel32 = 0) then RaiseLastOSError;
try
IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
finally
FreeLibrary(hKernel32);
end;
end;
function PidIs64BitsProcess(dwProcessId: DWORD): Boolean;
var
IsWow64 : BOOL;
PidHandle : THandle;
begin
Result := False;
if Assigned(IsWow64Process) then
begin
//check if the current app is running under WOW
if IsWow64Process(GetCurrentProcess(), IsWow64) then
Result := IsWow64
else
RaiseLastOSError;
//the current delphi App is not running under wow64, so the current Window OS is 32 bit
//and obviously all the apps are 32 bits.
if not Result then Exit;
PidHandle := OpenProcess(PROCESS_QUERY_INFORMATION,False,dwProcessId);
if PidHandle > 0 then
try
if (IsWow64Process(PidHandle, IsWow64)) then
Result := not IsWow64
else
RaiseLastOSError;
finally
CloseHandle(PidHandle);
end;
end;
end;
begin
try
Init_IsWow64Process;
//here pass the pid which you want to check
Writeln(BoolToStr(PidIs64BitsProcess(1940),True));
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
Readln;
end.
if you are checking for the app itself:
{$IFDEF WIN32}
ShowMessage('32-bit App itself');
{$ENDIF}
{$IFDEF WIN64}
ShowMessage('64-bit App itself');
{$ENDIF}