interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
function CreateProcess4LoggedOnUser(const cmd: String): Cardinal;
implementation
{$R *.dfm}
uses
TlHelp32;
function CreateProcess4LoggedOnUser(const cmd: String): Cardinal;
var
hToken : THandle;
newToken : THandle;
blub : Cardinal;
aSessionId : Cardinal;
aStartup : Windows.TStartupInfo;
aPI : Windows.TProcessInformation;
MyEnv : Pointer;
bla : DWORD;
f: textfile;
root: string;
var
CreateEnvironmentBlock: function(lpEnvironment: PPointer; hToken: THandle;
bInherit: BOOL): BOOL; stdcall;
WTSGetActiveConsoleSessionId: function: DWord; stdcall;
DestroyEnvironmentBlock: function(lpEnvironment: Pointer): BOOL; stdcall;
begin
@CreateEnvironmentBlock :=
GetProcAddress(LoadLibrary('userenv.dll'), 'CreateEnvironmentBlock');
@WTSGetActiveConsoleSessionId :=
GetProcAddress(LoadLibrary('kernel32.dll'), 'WTSGetActiveConsoleSessionId');
@DestroyEnvironmentBlock :=
GetProcAddress(LoadLibrary('userenv.dll'), 'DestroyEnvironmentBlock');
result := 0;
root:= 'D:\temp.txt';
assignfile(f, root);
rewrite(f);
writeln(f, datetimetostr(now())+ ' - Report des Dienstes:');
if Windows.OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, hToken) then
begin
Writeln(f, 'OpenProcessToken Ok');
if Windows.ImpersonateLoggedOnUser(hToken) then
begin
WriteLn(f,'ImpersonateLoggedOnUser Ok');
if Windows.DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil, SecurityImpersonation, TOKENPRIMARY, newToken) then
begin
WriteLn(f,'DuplicateTokenEx Ok');
aSessionId := WTSGetActiveConsoleSessionId;
bla := DWORD(aSessionId);
if Windows.SetTokenInformation(newToken, Windows.TokenSessionId, @bla, SizeOf(DWORD)) then //Hier wird ein Fehler ausgelöst: (Error-Code 1314): Dem Client fehlt ein erforderliches Recht
begin
WriteLn(f,'SetTokenInformation Ok');
FillChar(aStartup,SizeOf(TStartupInfo),#0);
FillChar(
aPI,SizeOf(TProcessInformation),#0);
aStartup.cb := SizeOf(TStartupInfo);
aStartup.lpDesktop := 'WinSta0\Default';
MyEnv := nil;
// Umgebungsvariablen werden vom Benutzer ermittelt.
if CreateEnvironmentBlock(@MyEnv, newToken, false) then
begin
WriteLn(f,'CreateEnvironmentBlock Ok');
if Windows.CreateProcessAsUser(newToken, pChar(cmd),
nil, nil, nil, true,
NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE or CREATE_UNICODE_ENVIRONMENT,
MyEnv, nil, aStartup ,
aPI) then
begin
WriteLn(f,'CreateProcessAsUser Ok');
CloseHandle(
aPI.hProcess);
CloseHandle(
aPI.hThread);
end
else
begin
result := GetLastError;
WriteLn(f,'7: '+Sysutils.SysErrorMessage(result));
end;
DestroyEnvironmentBlock(MyEnv);
end
else
begin
blub := Windows.GetLastError;
WriteLn(f,'CreateEnvironmentBlock('+IntToStr(blub)+'): ' + Sysutils.SysErrorMessage(blub));
end;
end
else
begin
blub := Windows.GetLastError;
WriteLn(f,'SetTokenInformation('+IntToStr(blub)+'): ' + Sysutils.SysErrorMessage(blub));
end;
end
else
WriteLn(f,'DuplicateTokenEx: ' + Sysutils.SysErrorMessage(Windows.GetLastError));
end
else
WriteLn(f,'ImpersonateLoggedOnUser: ' + Sysutils.SysErrorMessage(Windows.GetLastError));
end
else
WriteLn(f,'OpenProcessToken: ' + Sysutils.SysErrorMessage(Windows.GetLastError));
close(f);
end;
end.