| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Можно ли узнать имя родительского процесса в 64 разрядной винде? [D7, WinXP]
sniknik © (2010-06-17 11:42:00)Интересует естественно вариант из 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. Догадки, и тесты (типа что за ошибку дает вот в этом месте) могу проверить только вечером. А вот если есть "железный" вариант, то можно и сейчас побегать...
sniknik (2010-06-18 07:38:00) [1]> у меня не заработало...
Блин, проверил, у меня тоже ;(. Можно посмотреть ошибку от Module32First (валится тут похоже на ней), "завернуть" ее в Win32Check, но это после, на работу пора. ;)
KilkennyCat (2010-06-18 07:06:00) [2]Ага, я пробовал через снапшот, но где-то ошибался, у меня не заработало...
Появится еще время - оформлю все это в какой-нить PsApi2
sniknik (2010-06-18 00:22:00) [3]Еще один, наверное окончательный вариант... ;) обработка одного из проверенных здесь (отличие от того - дает полный путь, что и требуется в одном из случаев).
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;
На нем и остановлюсь.
KilkennyCat (2010-06-17 17:34:00) [4]да, юникод постоянно преподносит сюрпрайзы... хорошо еще, что тут очевидно.
KilkennyCat (2010-06-17 17:33:00) [5]исходный путь D:\
тупо сделал так: Move(sRes[1], lpFilename[0], result + 1000);
получилось -C:\Windows\explorer.exe
sniknik (2010-06-17 17:33:00) [6]> забавные пути...
У тебя с юникодом нужно размер char на 2 умножать... ну и все сдвинулось из-за этого.
sniknik (2010-06-17 17:31:00) [7]KilkennyCat © (17.06.10 17:10) [18]
Ну, вот это и требовалось.
Хотя тут вроде неправильно...
> из проводника win7x64 - C:\ Windows\ ediskVolume1\ Windows\explorer.exe
Похоже DevicePathToWin32Path криво отработал (опять юникод?). Какой у тебя тут исходный путь? От GetProcessImageFileName.
> еще дополнение - ниже указанные функции не повлияли на вышеуказанный результат
Судя по всему единственное проблемное это 64 vs нормального в 32.
KilkennyCat (2010-06-17 17:22:00) [8]
> из проводника 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:19:00) [9]ну и последнее забыл - результаты идентичны для пользователей с правами: администратора; домашних пользователей; пользователя.
KilkennyCat (2010-06-17 17:15:00) [10]еще дополнение - ниже указанные функции не повлияли на вышеуказанный результат
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;
KilkennyCat (2010-06-17 17:11:00) [11]напомню, на всяк пожарный, что тест проходит с коррекцией A на W
KilkennyCat (2010-06-17 17:10:00) [12]Работает при вызове из среды -
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
sniknik (2010-06-17 16:46:00) [13]Еще на проверку... ???
Уже ради новой функции 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;
sniknik (2010-06-17 15:45:00) [14]> это должно быть всем интересно, ибо x64 у юзверей все более и более...
Согласен. Мне самому тоже, оказывается... нашел в другой проге использование GetModuleFileNameEx ... счастье, что ее еще под x64 не запускали. Как понимаю как только так будет та же проблема (там у меня ей читается полный путь к программе, а т.к. это единственное чем разделяются копии... в общем можно продолжить).
KilkennyCat (2010-06-17 15:31:00) [15]Ну, я еще потрепыхался, немного переписал PSAPI и вызвал K32GetModuleBaseNameW из kernel32 - разницы нет, если родитель 32 - работает, если 64 - не работает
> если кому вообще это интересно
это должно быть всем интересно, ибо x64 у юзверей все более и более...
sniknik (2010-06-17 15:25:00) [16]> GetModuleFileNameExW тоже не работает при родителе x64
Ну и ладно, все остальное это уже чисто ради интереса (если кому вообще это интересно), меня и перебор процессов устроит, все одно делается это только один раз при старте.
> а как принудительно заставить компилятор принять PSAPI_VERSION=1 и надо ли это делать?
Х.з.
KilkennyCat (2010-06-17 15:11:00) [17]
> то скорее всего из-за "юникодности" твоей дельфи из-за которой
> мой код стал не совсем правильным.
разумеется, но это я подправил (GetModuleBaseNameW(Hndl, 0, PWideChar(ProcessName), MAX_PATH)
> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
> У меня присутствует
гм... странно.
вообще, как я понял из MSDN, ее нет, и все должно корректно работать, если ее вызов подменяется вызовом K32GetModuleBaseName,
> Проверь если не сложно.
GetModuleFileNameExW тоже не работает при родителе x64
а как принудительно заставить компилятор принять PSAPI_VERSION=1 и надо ли это делать? (попалось обсуждение аналогичной проблемы у драйверописателей)
sniknik (2010-06-17 14:58:00) [18]> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
У меня присутствует, но использовать наверное лучше GetModuleFileNameEx Aв моем варианте (у тебя если Delphi10, с юникодом Delphi10 GetModuleFileNameEx W).
Проверь если не сложно.
> первый - ошибка
Это скорее всего из-за "юникодности" твоей дельфи из-за которой мой код стал не совсем правильным.
KilkennyCat (2010-06-17 14:54:00) [19]
> А что с ним тоже работает?
да вот пытаюсь разобраться, существует ли она ваще в природе...
sniknik (2010-06-17 14:50:00) [20]> Работает!
Спасибо!
> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
А что с ним тоже работает?
| |
Страницы: 