Hm, sehr seltsam, ich hab den Code aus x000xs erstem Beitrag probiert, komme aber gar nicht zu der jeweiligen Stelle, weil schon
CreateEnvironmentBlock mit Fehler 203 fehlschlägt.
Wenn ich als Token an diese Funktion 0 übergebe, funktioniert das Starten beispielsweise des Taskmanagers, aber halt nicht des Explorers
Hier ist das Listing. Die auskommentierte Zeile oben ist aus dem Original, der Ersatz, der bei mir funktioniert, steht direkt darunter.
Delphi-Quellcode:
program RunAsUserTest;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Dialogs;
function CreateProcessWithLogon(lpUsername: PWideChar;
lpDomain: PWideChar;
lpPassword: PWideChar;
dwLogonFlags: DWORD;
lpApplicationName: PWideChar;
lpCommandLine: PWideChar;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar;
var lpStartupInfo: TStartupInfo;
var lpProcessInfo: TProcessInformation): BOOL; stdcall;
external 'advapi32' name 'CreateProcessWithLogonW';
function CreateEnvironmentBlock(var lpEnvironment: Pointer;
hToken: THandle;
bInherit: BOOL): BOOL; stdcall; external 'userenv';
function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall; external 'userenv';
const
LOGON_WITH_PROFILE = $00000001;
function RunAs(User, Password, Command: String): Integer;
var dwSize: DWORD;
hToken: THandle;
lpvEnv: Pointer;
pi: TProcessInformation;
si: TStartupInfo;
szPath: Array [0..MAX_PATH] of WideChar;
begin
ZeroMemory(@szPath, SizeOf(szPath));
ZeroMemory(@pi, SizeOf(pi));
ZeroMemory(@si, SizeOf(si));
si.cb:=SizeOf(TStartupInfo);
if LogonUser(PChar(User), '.', PChar(Password), LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hToken) then
begin
//if CreateEnvironmentBlock(lpvEnv, hToken, True) then
if CreateEnvironmentBlock(lpvEnv, 0, True) then
begin
dwSize:=SizeOf(szPath) div SizeOf(WCHAR);
if (GetCurrentDirectoryW(dwSize, @szPath) > 0) then
begin
if (CreateProcessWithLogon(PWideChar(WideString(User)), nil, PWideChar(WideString(Password)),
LOGON_WITH_PROFILE, nil, PWideChar(WideString(Command)), CREATE_UNICODE_ENVIRONMENT,
lpvEnv, szPath, si, pi)) then
begin
result:=ERROR_SUCCESS;
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end
else
result:=GetLastError;
end
else
result:=GetLastError;
DestroyEnvironmentBlock(lpvEnv);
end
else
result:=GetLastError;
CloseHandle(hToken);
end
else
result:=GetLastError;
end;
var
res: Integer;
user, pass: string;
begin
Write('Benutzername angeben: ');
ReadLn(user);
Write('Passwort angeben: ');
ReadLn(pass);
WriteLn('Prozess wird gestartet...');
res := RunAs(user, pass, 'c:\windows\explorer.exe ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}');
//res := RunAs(user, pass, 'c:\windows\system32\taskmgr.exe');
if (res <> ERROR_SUCCESS) then
begin
WriteLn('Fehler ', res, ': ', SysErrorMessage(res));
end
else
begin
WriteLn('Prozess gestartet.');
end;
Readln;
end.
Kann das jemand vielleicht mal bei sich ausprobieren? Interessant ist zum einen, ob bei euch die Sache mit dem
CreateEnvironmentBlock funktioniert und zum anderen, ob der Explorer gestartet wird.