-
Интересует естественно вариант из 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. Догадки, и тесты (типа что за ошибку дает вот в этом месте) могу проверить только вечером. А вот если есть "железный" вариант, то можно и сейчас побегать...
-
рискну пальцем в небо ткнуть...
if NtQueryInformationProcess(GetCurrentProcess, 26, @Info, SizeOf(Info), nil) = NO_ERROR
-
Проверю вечером.
-
я ща сам проверю... я на семерке
-
не, не помогло.
-
Оно и понятно... посмотрел 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.
т.е. это просто "информационный дубль".
-
ну. но я подумал, фиг знает... уже бывало, напишут одно, работает по-другому.
-
> я ща сам проверю... я на семерке А вот такой "тупой" перебор не проверишь? Мало надежды конечно, но ... > напишут одно, работает по-другому.
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;
-
Работает!
В первом варианте, как я понял, не отрабатывает GetModuleBaseNameA.
Тестировалось на Delphi10, win7 x64, AMD 4ядра
при запуске из под делфи оба варианта выдают bds.exe
при запуске из IE64 (умнее не придумал) первый - ошибка, второй - iexplore.exe
-
GetModuleBaseNameEx в PsAPI отсутствует, а зря...
-
> Работает!
Спасибо!
> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
А что с ним тоже работает?
-
> А что с ним тоже работает?
да вот пытаюсь разобраться, существует ли она ваще в природе...
-
> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
У меня присутствует, но использовать наверное лучше GetModuleFileNameExA в моем варианте (у тебя если Delphi10, с юникодом Delphi10 GetModuleFileNameExW).
Проверь если не сложно.
> первый - ошибка
Это скорее всего из-за "юникодности" твоей дельфи из-за которой мой код стал не совсем правильным.
-
> то скорее всего из-за "юникодности" твоей дельфи из-за которой
> мой код стал не совсем правильным.
разумеется, но это я подправил (GetModuleBaseNameW(Hndl, 0, PWideChar(ProcessName), MAX_PATH)
> GetModuleBaseNameEx в PsAPI отсутствует, а зря...
> У меня присутствует
гм... странно.
вообще, как я понял из MSDN, ее нет, и все должно корректно работать, если ее вызов подменяется вызовом K32GetModuleBaseName,
> Проверь если не сложно.
GetModuleFileNameExW тоже не работает при родителе x64
а как принудительно заставить компилятор принять PSAPI_VERSION=1 и надо ли это делать? (попалось обсуждение аналогичной проблемы у драйверописателей)
-
> GetModuleFileNameExW тоже не работает при родителе x64
Ну и ладно, все остальное это уже чисто ради интереса (если кому вообще это интересно), меня и перебор процессов устроит, все одно делается это только один раз при старте.
> а как принудительно заставить компилятор принять PSAPI_VERSION=1 и надо ли это делать?
Х.з.
-
Ну, я еще потрепыхался, немного переписал PSAPI и вызвал K32GetModuleBaseNameW из kernel32 - разницы нет, если родитель 32 - работает, если 64 - не работает
> если кому вообще это интересно
это должно быть всем интересно, ибо x64 у юзверей все более и более...
-
> это должно быть всем интересно, ибо x64 у юзверей все более и более...
Согласен. Мне самому тоже, оказывается... нашел в другой проге использование GetModuleFileNameEx ... счастье, что ее еще под x64 не запускали. Как понимаю как только так будет та же проблема (там у меня ей читается полный путь к программе, а т.к. это единственное чем разделяются копии... в общем можно продолжить).
-
Еще на проверку... ??? Уже ради новой функции 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;
-
Работает при вызове из среды - 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
-
напомню, на всяк пожарный, что тест проходит с коррекцией A на W
|
Есть новые 
Нет новых [134431 +10][b:0][p:0.003]