Можно ли узнать имя родительского процесса в 64 разрядной винде?

← →
sniknik © (2010-06-17 11:42) [0]

Интересует естественно вариант из 32 разрядной программы на Delphi запущенной 64 разрядным "родителем".
Ну и понятно не интересно если, это будет имя виртуальной машины (или чего там) т.е. что-то промежуточное, и всегда одинаковое (хотя сейчас и это не получается).

Вариант работающий в 32 разрядной -
type PROCESS_BASIC_INFORMATION = packed record ExitStatus: DWORD; PebBaseAddress: Pointer; AffinityMask: DWORD; BasePriority: DWORD; uUniqueProcessId: Ulong; uInheritedFromUniqueProcessId: Ulong; end; function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: Byte; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD; stdcall; external "ntdll.dll"; function ParentProcName: string; var Info: PROCESS_BASIC_INFORMATION; ProcessName: string; Hndl: THandle; begin result:= "noname"; if NtQueryInformationProcess(GetCurrentProcess, 0, @Info, SizeOf(Info), nil) = NO_ERROR then begin Hndl:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, Info.uInheritedFromUniqueProcessId); if Hndl <> 0 then try SetLength(ProcessName, MAX_PATH); if GetModuleBaseNameA(Hndl, 0, PChar(ProcessName), MAX_PATH) > 0 then result:= PChar(ProcessName); finally CloseHandle(Hndl); end; end; end;
в 64, не работает... (??? на проверки было мало времени, т.к. ограничен доступ к 64 винде. но вроде те пару раз, что выдало "noname" показательны)

p.s. Догадки, и тесты (типа что за ошибку дает вот в этом месте) могу проверить только вечером. А вот если есть "железный" вариант, то можно и сейчас побегать...

← →
KilkennyCat © (2010-06-17 12:46) [1]

рискну пальцем в небо ткнуть...
if NtQueryInformationProcess(GetCurrentProcess, 26, @Info, SizeOf(Info), nil) = NO_ERROR

← →
sniknik © (2010-06-17 12:49) [2]

Проверю вечером.

← →
KilkennyCat © (2010-06-17 12:50) [3]

я ща сам проверю... я на семерке

← →
KilkennyCat © (2010-06-17 13:13) [4]

не, не помогло.

← →
sniknik © (2010-06-17 13:15) [5]

Оно и понятно... посмотрел MSDN

ProcessWow64Information 26
-
Determines whether the process is running in the WOW64 environment (WOW64 is the x86 emulator that allows Win32-based applications to run on 64-bit Windows).

It is best to use the IsWow64Process function to obtain this information.

т.е. это просто "информационный дубль".

← →
KilkennyCat © (2010-06-17 13:31) [6]

ну. но я подумал, фиг знает... уже бывало, напишут одно, работает по-другому.

← →
sniknik © (2010-06-17 13:59) [7]

> я ща сам проверю... я на семерке
А вот такой "тупой" перебор не проверишь? Мало надежды конечно, но ...
> напишут одно, работает по-другому.

uses ... TlHelp32; function ParentProcName2: string; var i: integer; ProcessID, ParentProcessID: DWORD; hSnapshot: THandle; ProcessEntry: TProcessEntry32; ProcessList: TStringList; begin result:= "noname"; ProcessList:= TStringList.Create; try ProcessID:= GetCurrentProcessID; ParentProcessID:= 0; hSnapshot:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapshot <> INVALID_HANDLE_VALUE then try ProcessEntry.dwSize:= SizeOf(ProcessEntry); if Process32First(hSnapshot, ProcessEntry) then begin repeat ProcessList.AddObject(ProcessEntry.szExeFile, TObject(ProcessEntry.th32ProcessID)); if ProcessEntry.th32ProcessID = ProcessID then ParentProcessID:= ProcessEntry.th32ParentProcessID; until not Process32Next(hSnapshot, ProcessEntry) end finally CloseHandle(hSnapshot) end; if ParentProcessID <> 0 then begin i:= ProcessList.IndexOfObject(TObject(ParentProcessID)); if i <> -1 then result:= ProcessList.Strings[i] end; finally ProcessList.Free end; end;

← →
KilkennyCat © (2010-06-17 14:24) [8]

Работает!

В первом варианте, как я понял, не отрабатывает GetModuleBaseNameA.

Тестировалось на Delphi10, win7 x64, AMD 4ядра
при запуске из под делфи оба варианта выдают bds.exe
при запуске из IE64 (умнее не придумал) первый - ошибка, второй - iexplore.exe

← →
KilkennyCat © (2010-06-17 14:33) [9]

GetModuleBaseNameEx в PsAPI отсутствует, а зря...

← →
sniknik © (2010-06-17 14:50) [10]

> Работает!
Спасибо!

> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
А что с ним тоже работает?

← →
KilkennyCat © (2010-06-17 14:54) [11]

> А что с ним тоже работает?

да вот пытаюсь разобраться, существует ли она ваще в природе...

← →
sniknik © (2010-06-17 14:58) [12]

> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
У меня присутствует, но использовать наверное лучше GetModuleFileNameExA в моем варианте (у тебя если Delphi10, с юникодом Delphi10 GetModuleFileNameExW).

Проверь если не сложно.

> первый - ошибка
Это скорее всего из-за "юникодности" твоей дельфи из-за которой мой код стал не совсем правильным.

← →
KilkennyCat © (2010-06-17 15:11) [13]

> то скорее всего из-за "юникодности" твоей дельфи из-за которой
> мой код стал не совсем правильным.

разумеется, но это я подправил (GetModuleBaseNameW(Hndl, 0, PWideChar(ProcessName), MAX_PATH)

> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
> У меня присутствует

гм... странно.
вообще, как я понял из MSDN, ее нет, и все должно корректно работать, если ее вызов подменяется вызовом K32GetModuleBaseName,

> Проверь если не сложно.

GetModuleFileNameExW тоже не работает при родителе x64

а как принудительно заставить компилятор принять PSAPI_VERSION=1 и надо ли это делать? (попалось обсуждение аналогичной проблемы у драйверописателей)

← →
sniknik © (2010-06-17 15:25) [14]

> GetModuleFileNameExW тоже не работает при родителе x64
Ну и ладно, все остальное это уже чисто ради интереса (если кому вообще это интересно), меня и перебор процессов устроит, все одно делается это только один раз при старте.

> а как принудительно заставить компилятор принять PSAPI_VERSION=1 и надо ли это делать?
Х.з.

← →
KilkennyCat © (2010-06-17 15:31) [15]

Ну, я еще потрепыхался, немного переписал PSAPI и вызвал K32GetModuleBaseNameW из kernel32 - разницы нет, если родитель 32 - работает, если 64 - не работает

> если кому вообще это интересно

это должно быть всем интересно, ибо x64 у юзверей все более и более...

← →
sniknik © (2010-06-17 15:45) [16]

> это должно быть всем интересно, ибо x64 у юзверей все более и более...
Согласен. Мне самому тоже, оказывается... нашел в другой проге использование GetModuleFileNameEx ... счастье, что ее еще под x64 не запускали. Как понимаю как только так будет та же проблема (там у меня ей читается полный путь к программе, а т.к. это единственное чем разделяются копии... в общем можно продолжить).

← →
sniknik © (2010-06-17 16:46) [17]

Еще на проверку... ???
Уже ради новой функции GetModuleFileNameEx.

function GetProcessImageFileName(hProcess: tHANDLE; lpImageFileName: LPTSTR; nSize: DWORD): DWORD; stdcall; external "psapi.dll" name "GetProcessImageFileNameA"; function ParentProcName: string; var Info: PROCESS_BASIC_INFORMATION; ProcessName: string; Hndl: THandle; function GetModuleFileNameEx(hProcess: THandle; lpFilename: PChar; nSize: DWORD): DWORD; function DevicePathToWin32Path(lpFilename: PChar): DWORD; var c: char; sPath, sRes, s: string; i: integer; begin sPath:= lpFilename; i:= PosEx("\", sPath, 2); i:= PosEx("\", sPath, i + 1); sRes:= Copy(sPath, i, Length(sPath)); Delete(sPath, i, Length(sPath)); for c:= "A" to "Z" do begin SetLength(s, MAX_PATH); if QueryDosDevice(PChar(String(c) + ":"), PChar(s), 1000) <> 0 then begin s:= PChar(s); if SameText(sPath, s) then begin sRes:= c + ":" + sRes; result:= Length(sRes); Move(sRes[1], lpFilename[0], result + 1); Exit; end; end; end; result:= 0; end; begin result:= GetProcessImageFileName(hProcess, lpFilename, nSize); if result > 0 then result:= DevicePathToWin32Path(lpFilename); end; begin result:= "noname"; if NtQueryInformationProcess(GetCurrentProcess, 0, @Info, SizeOf(Info), nil) = NO_ERROR then begin Hndl:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, Info.uInheritedFromUniqueProcessId); if Hndl <> 0 then try SetLength(ProcessName, MAX_PATH); if GetModuleFileNameEx(Hndl, PChar(ProcessName), MAX_PATH) > 0 then result:= PChar(ProcessName); finally CloseHandle(Hndl); end; end; end;

← →
KilkennyCat © (2010-06-17 17:10) [18]

Работает при вызове из среды - C:\Program Files (x86)\Embarcad Files (x86)\Embarcadero\RAD Studio\7.0\bin\bds.exe

из проводника win7x64 - C:\Windows\ediskVolume1\Windows\explorer.exe

родитель ie64 - C:\Program Files\InterneProgram Files\Internet Explorer\iexplore.exe

ie32 - C:\Program Files (x86)\Integram Files (x86)\Internet Explorer\iexplore.exe

← →
KilkennyCat © (2010-06-17 17:11) [19]

напомню, на всяк пожарный, что тест проходит с коррекцией A на W

← →
KilkennyCat © (2010-06-17 17:15) [20]

еще дополнение - ниже указанные функции не повлияли на вышеуказанный результат

procedure EnableAllPrivileges; var c1, c2 : dword; ptp : PTokenPrivileges; i1 : integer; begin if OpenProcessToken(windows.GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, c1) then try c2 := 0; GetTokenInformation(c1, TokenPrivileges, nil, 0, c2); if c2 <> 0 then begin ptp := AllocMem(c2); if GetTokenInformation(c1, TokenPrivileges, ptp, c2, c2) then begin for i1 := 0 to integer(ptp^.PrivilegeCount) - 1 do ptp^.Privileges[i1].Attributes := ptp^.Privileges[i1].Attributes or SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(c1, false, ptp^, c2, PTokenPrivileges(nil)^, cardinal(pointer(nil)^)); end; FreeMem(ptp); end; finally CloseHandle(c1) end; end; function ChangeFSRedirection(bDisable: Boolean): Boolean; type TWow64DisableWow64FsRedirection = Function(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall; TWow64EnableWow64FsRedirection = Function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall; var hHandle: THandle; Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection; Wow64EnableWow64FsRedirection: TWow64EnableWow64FsRedirection; Wow64FsEnableRedirection: LongBool; begin Result := false; // if not IsWindows64 then // Exit; try hHandle := GetModuleHandle("kernel32.dll"); @Wow64EnableWow64FsRedirection := GetProcAddress(hHandle, "Wow64EnableWow64FsRedirection"); @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, "Wow64DisableWow64FsRedirection"); if bDisable then begin if (hHandle <> 0) and (@Wow64DisableWow64FsRedirection <> nil) then begin Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection); Result := True; end; end else begin if (hHandle <> 0) and (@Wow64EnableWow64FsRedirection <> nil) then begin Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection); Result := True; end; end; Except end; end;

ну и последнее забыл - результаты идентичны для пользователей с правами: администратора; домашних пользователей; пользователя.

> из проводника win7x64 - C:\Windows\ediskVolume1\Windows\explorer.
> exe
>
> родитель ie64 - C:\Program Files\InterneProgram Files\Internet
> Explorer\iexplore.exe
>
> ie32 - C:\Program Files (x86)\Integram Files (x86)\Internet
> Explorer\iexplore.exe

забавные пути...

KilkennyCat © (17.06.10 17:10) [18]
Ну, вот это и требовалось.

Хотя тут вроде неправильно...
> из проводника win7x64 - C:\Windows\ediskVolume1\Windows\explorer.exe
Похоже DevicePathToWin32Path криво отработал (опять юникод?). Какой у тебя тут исходный путь? От GetProcessImageFileName.

> еще дополнение - ниже указанные функции не повлияли на вышеуказанный результат
Судя по всему единственное проблемное это 64 vs нормального в 32.

> забавные пути...
У тебя с юникодом нужно размер char на 2 умножать... ну и все сдвинулось из-за этого.

исходный путь D:\
тупо сделал так: Move(sRes[1], lpFilename[0], result + 1000);
получилось - C:\Windows\explorer.exe

да, юникод постоянно преподносит сюрпрайзы... хорошо еще, что тут очевидно.

Еще один, наверное окончательный вариант... ;) обработка одного из проверенных здесь (отличие от того - дает полный путь, что и требуется в одном из случаев).
uses ... TlHelp32; function GetModuleFileName(pID: DWORD): string; var hSnapshot: THandle; mEntr: tagMODULEENTRY32; begin result:= "noname"; hSnapshot:= CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID); if hSnapshot <> INVALID_HANDLE_VALUE then try mEntr.dwSize:= SizeOf(mEntr); if Module32First(hSnapshot, mEntr) then result:= mEntr.szExePath; finally CloseHandle(hSnapshot) end; end; function ParentProcName: string; var pID: DWORD; hSnapshot: THandle; ProcessEntry: TProcessEntry32; begin result:= "noname"; hSnapshot:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapshot <> INVALID_HANDLE_VALUE then try ProcessEntry.dwSize:= SizeOf(ProcessEntry); if Process32First(hSnapshot, ProcessEntry) then begin pID:= GetCurrentProcessID; repeat if ProcessEntry.th32ProcessID = pID then begin result:= GetModuleFileName(ProcessEntry.th32ParentProcessID); Break; end; until not Process32Next(hSnapshot, ProcessEntry); end; finally CloseHandle(hSnapshot) end; end;
На нем и остановлюсь.

Ага, я пробовал через снапшот, но где-то ошибался, у меня не заработало...
Появится еще время - оформлю все это в какой-нить PsApi2

> у меня не заработало...
Блин, проверил, у меня тоже ;(. Можно посмотреть ошибку от Module32First (валится тут похоже на ней), "завернуть" ее в Win32Check, но это после, на работу пора. ;)

Можно ли узнать имя родительского процесса в 64 разрядной винде? Найти похожие ветки