// Auszug der betroffenen Methoden
// Diese Methode holt per Window-Caption die entsprechende ProcessID ab
function TTarget._GetPIDByCaption(
const _Caption:
string): Cardinal;
var
Win: HWND;
_PID: DWORD;
begin
Result := 0;
if _Caption = '
'
then
Exit;
Win := FindWindow(
nil, PChar(_Caption));
if Win > 0
then
begin
GetWindowThreadProcessID(Win, @_PID);
if ((_PID > 0)
and (_GetUserNameFromPID(_PID) = _GetLocalUserName))
then
Result := _PID;
end;
end;
// Diese Methode holt per Dateinamen die entsprechende ProcessID ab
function TTarget._GetPIDByName(
const ExeName:
string): Cardinal;
var
Process: THANDLE;
ProcessEntry: TProcessEntry32;
begin
Result := 0;
if ExeName = '
'
then
Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
Process := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (Process32First(Process, ProcessEntry))
then
repeat
if ((LowerCase(ProcessEntry.szExeFile) = LowerCase(ExeName))
and
(_GetUserNameFromPID(ProcessEntry.th32ProcessID) = _GetLocalUserName))
then
begin
Result := ProcessEntry.th32ProcessID;
CloseHandle(Process);
Exit;
end;
until (
not Process32Next(Process, ProcessEntry));
CloseHandle(Process);
end;
// Diese Methode steuert die beiden oberen
function TTarget.GetPID: DWORD;
var
PID: DWORD;
begin
Result := 0;
PID := _GetPIDByName('
Dateiname.exe');
// diese methode versteht es mehrere prozesse mit dem selben Dateiname.exe zu durchforsten
if PID = 0
then // falls Dateiname.exe umbenannt wurde (oder tatsächlich noch nicht gestartet wurde)
PID := _GetPIDByCaption('
Fenster Titel');
// zusätzlich nach einem Fenster ausschau halten, man weiß ja nie
if PID > 0
then
Result := PID;
end;
// Diese Methode holt den aktuell angemeldeten User-Namen ab
function TTarget._GetLocalUserName:
string;
var
aLength: DWORD;
aUserName:
array [0 .. MAX_PATH - 1]
of WideChar;
begin
aLength := MAX_PATH;
if GetUserName(@aUserName, aLength)
then
Result := aUserName
else
raise Exception.Create(SysErrorMessage(GetLastError));
end;
// eine reparierte Version die für beide Methoden (Caption/Filename) gleich gut arbeitet
// Diese Methode gibt den User-Namen wieder der die ProzessID gestartet hat
function TTarget._GetUserNameFromPID(PID: DWORD):
string;
var
hToken: THANDLE;
cbBuf: Cardinal;
pUser: PTokenUser;
// dies war vorher eine fehlerquelle, danke windows.pas, wer lesen kann ist klar im vorteil :-)
snu: SID_NAME_USE;
ProcessHandle: THANDLE;
UserSize: DWORD;
DomainSize: DWORD;
bSuccess: Boolean;
User, Domain:
string;
begin
Result := '
';
UserSize := 0;
DomainSize := 0;
pUser :=
nil;
if PID = 0
then
PID := GetCurrentProcessId();
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, PID);
if ProcessHandle <> INVALID_HANDLE_VALUE
then
begin
if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken)
then
begin
bSuccess := GetTokenInformation(hToken, TokenUser,
nil, 0, cbBuf);
while (
not bSuccess)
and (GetLastError = ERROR_INSUFFICIENT_BUFFER)
do
begin
ReallocMem(pUser, cbBuf);
bSuccess := GetTokenInformation(hToken, TokenUser, pUser, cbBuf, cbBuf);
end;
CloseHandle(hToken);
if not bSuccess
then
Exit;
LookupAccountSid(
nil, pUser^.User.Sid,
nil, UserSize,
nil,
DomainSize, snu);
if (UserSize <> 0)
and (DomainSize <> 0)
then
begin
SetLength(User, UserSize);
SetLength(Domain, DomainSize);
if LookupAccountSid(
nil, pUser^.User.Sid, PChar(User), UserSize,
PChar(Domain), DomainSize, snu)
then
begin
User := StrPas(PChar(User));
Domain := StrPas(PChar(Domain));
Result := User;
end;
end;
if bSuccess
then
FreeMem(pUser);
end;
CloseHandle(ProcessHandle);
end;
end;