function GetProcessID(Exename:
string): DWord;
var
hProcSnap: THandle;
pe32: TProcessEntry32;
begin
result := 0;
hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
if hProcSnap <> INVALID_HANDLE_VALUE
then
begin
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(hProcSnap, pe32) = true
then
begin
while Process32Next(hProcSnap, pe32) = true
do
begin
if pos(Exename, pe32.szExeFile) <> 0
then
result := pe32.th32ProcessID;
end;
end;
CloseHandle(hProcSnap);
end;
end;
Function GetModuleBaseAddress(dwProcID: DWord; szModule: pChar): Cardinal;
var
xModule: TMODULEENTRY32;
hSnap: THandle;
begin
hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, dwProcID);
xModule.dwSize := SizeOf(MODULEENTRY32);
Module32First(hSnap, xModule);
repeat
if LowerCase(xModule.szModule) = LowerCase(szModule)
then
begin
result := Cardinal(xModule.modBaseAddr);
break;
end;
until (
not(Module32Next(hSnap, xModule)));
CloseHandle(hSnap);
end;
procedure TForm2.Button1Click(Sender: TObject);
var
pe32: TProcessEntry32;
dwClientBase, dwBytes, dwProcID: DWord;
dwEngineBase : Cardinal;
hProcess: THandle;
begin
dwProcID := GetProcessID('
xxx.exe');
if dwProcID <> 0
then
begin
// Showmessage(inttostr(dwProcID));
hProcess := OpenProcess(PROCESS_ALL_ACCESS, FALSE, dwProcID);
// Showmessage(inttostr(hProcess));
if (hProcess = INVALID_HANDLE_VALUE)
then
begin
Showmessage('
Finde Handle nicht');
exit;
end;
// This seems to crash on Vista, which I'm running atm. works on XP.
dwEngineBase := GetModuleBaseAddress(dwProcID, '
xxxx.exe');
Showmessage(inttostr(dwEngineBase));
// dwClientBase := GetModuleBaseAddress( dwProcID, 'xxxxx.dll' );
// Putting manual addresses right now instead.
// dwEngineBase := $20000000;
// dwClientBase := $24000000;
dwBytes := 0;
end
else
begin
Showmessage('
Finde Prozess nicht');
end;
end;