uses Windows, PsAPI, SysUtils;
const
SE_SECURITY_NAME = 'SeSecurityPrivilege';
PROC_THREAD_ATTRIBUTE_PARENT_PROCESS = $00020000;
EXTENDED_STARTUPINFO_PRESENT = $00080000;
type
PPROC_THREAD_ATTRIBUTE_LIST = Pointer;
STARTUPINFOEX = packed record
StartupInfo: TStartupInfo;
lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST;
end;
function InitializeProcThreadAttributeList(lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST; dwAttributeCount, dwFlags: DWORD; var lpSize: Cardinal): Boolean; stdcall;
external 'kernel32.dll';
procedure UpdateProcThreadAttribute(lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST; dwFlags, Attribute: DWORD; var pValue: DWORD; cbSize: Cardinal; pPreviousValue: Pointer;
pReturnSize: PCardinal); stdcall; external 'kernel32.dll';
procedure DeleteProcThreadAttributeList(lpAttributeList: PPROC_THREAD_ATTRIBUTE_LIST); stdcall; external 'Kernel32.dll';
function EnableDebugPrivilege(PrivName: string; CanDebug: Boolean): Boolean;
var
TP : Windows.TOKEN_PRIVILEGES;
Dummy : Cardinal;
hToken: THandle;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
TP.PrivilegeCount := 1;
LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
if CanDebug then
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
TP.Privileges[0].Attributes := 0;
Result := AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
hToken := 0;
end;
function GetProcessIDFromProcessName(const ProcessName: WideString): DWORD;
var
hProcesss : array [0 .. 100] of DWORD;
I, J, Count : Cardinal;
pList : array of DWORD;
hProcess : Cardinal;
PathFileName: array [0 .. 255] of char;
begin
Result := 0;
EnumProcesses(@hProcesss, SizeOf(hProcesss), Count);
SetLength(pList, Count div SizeOf(DWORD));
Move(hProcesss, pList[0], Count);
for I := low(pList) to High(pList) do
begin
if (pList[I] = 0) or (pList[I] = 4) then
begin
Result := 0;
Continue;
end;
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pList[I]);
GetModuleFileNameEx(hProcess, 0, PathFileName, 255);
CloseHandle(hProcess);
J := Pos(LowerCase(ProcessName), LowerCase(PathFileName));
if J <= 0 then
Continue;
Result := pList[I];
Exit;
end;
end;
procedure CreateProcessOnParentProcess(ExeName: string);
var
pi : TProcessInformation;
si : STARTUPINFOEX;
cbAListSize: Cardinal;
pAList : PPROC_THREAD_ATTRIBUTE_LIST;
hParent : Cardinal;
begin
EnableDebugPrivilege(SE_SECURITY_NAME, True);
FillChar(si, SizeOf(si), 0);
si.StartupInfo.cb := SizeOf(si);
si.StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
si.StartupInfo.wShowWindow := SW_SHOWDEFAULT;
FillChar(pi, SizeOf(pi), 0);
cbAListSize := 0;
InitializeProcThreadAttributeList(nil, 1, 0, cbAListSize);
pAList := HeapAlloc(GetProcessHeap(), 0, cbAListSize);
InitializeProcThreadAttributeList(pAList, 1, 0, cbAListSize);
hParent := OpenProcess(PROCESS_ALL_ACCESS, False, GetProcessIDFromProcessName('explorer.exe'));
UpdateProcThreadAttribute(pAList, 0, PROC_THREAD_ATTRIBUTE_PARENT_PROCESS, hParent, 4, nil, nil);
si.lpAttributeList := pAList;
if CreateProcess(PWideChar(ExeName), nil, nil, nil, False, EXTENDED_STARTUPINFO_PRESENT, nil, nil, si.StartupInfo, pi) then
begin
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
DeleteProcThreadAttributeList(pAList);
HeapFree(GetProcessHeap(), 0, pAList);
end;