function OpenShellProcessToken(ProcessName:
String;
var hToken: THandle): Boolean;
var
hSnapshot,
hProcess: THandle;
Process: TProcessEntry32;
begin
Result := false;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapshot <> 0)
and (hSnapshot <> INVALID_HANDLE_VALUE)
then
try
FillChar(Process, SizeOf(Process), #0);
Process.dwSize := SizeOf(Process);
if Process32First(hSnapshot, Process)
then
repeat
if (AnsiLowerCase(Process.szExeFile) =
AnsiLowerCase(ProcessName))
then
begin
hProcess :=
OpenProcess(PROCESS_ALL_ACCESS, false, Process.th32ProcessID);
if (hProcess <> 0)
and (hProcess <> INVALID_HANDLE_VALUE)
then
try
Result := OpenProcessToken(hProcess, TOKEN_ALL_ACCESS, hToken);
finally
CloseHandle(hProcess);
end;
Break;
end;
until (
not Process32Next(hSnapshot, Process));
finally
CloseHandle(hSnapshot);
end;
end;
function CreateUserProcess(lpApplicationName: PChar; lpCommandLine: PChar;
lpCurrentDirectory: PChar;
var ProcessInfo: TProcessInformation): Boolean;
var
WTSGetActiveConsoleSessionId:
function: DWord;
stdcall;
WTSQueryUserToken:
function(SessionId: ULONG;
var phToken: THandle): BOOL;
stdcall;
CreateEnvironmentBlock:
function(lpEnvironment: PPointer; hToken: THandle;
bInherit: BOOL): BOOL;
stdcall;
DestroyEnvironmentBlock:
function(lpEnvironment: LPVOID): BOOL;
stdcall;
var
hUserToken : THandle;
ReturnLength,
Environment: Pointer;
StartupInfo:
{$IFDEF UNICODE}TStartupInfoW
{$ELSE}TStartupInfoA
{$ENDIF};
begin
Result := false;
@CreateEnvironmentBlock :=
GetProcAddress(LoadLibrary('
userenv.dll'), '
CreateEnvironmentBlock');
@DestroyEnvironmentBlock :=
GetProcAddress(LoadLibrary('
userenv.dll'), '
DestroyEnvironmentBlock');
if (
not Assigned(CreateEnvironmentBlock))
or
(
not Assigned(DestroyEnvironmentBlock))
then Exit;
@WTSGetActiveConsoleSessionId :=
GetProcAddress(LoadLibrary('
kernel32.dll'), '
WTSGetActiveConsoleSessionId');
@WTSQueryUserToken :=
GetProcAddress(LoadLibrary('
wtsapi32.dll'), '
WTSQueryUserToken');
if (Assigned(WTSGetActiveConsoleSessionId)
and
Assigned(WTSQueryUserToken))
then
begin
Result := WTSQueryUserToken(WTSGetActiveConsoleSessionId, hUserToken);
end else
begin
Result := OpenShellProcessToken(GetShellProcName, hUserToken);
end;
if Result
then
try
if CreateEnvironmentBlock(@Environment, hUserToken, false)
then
try
ZeroMemory(@StartupInfo, sizeof(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.lpDesktop := '
winsta0\default';
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWDEFAULT;
Result := CreateProcessAsUser
(hUserToken,
lpApplicationName,
lpCommandLine,
nil,
nil,
false,
CREATE_NEW_CONSOLE
or CREATE_DEFAULT_ERROR_MODE
or CREATE_UNICODE_ENVIRONMENT,
Environment,
lpCurrentDirectory,
StartupInfo,
ProcessInfo);
finally
DestroyEnvironmentBlock(Environment);
end;
finally
CloseHandle(hUserToken);
end;
end;