RunAs für Windows 2000

[kuba]

Hy,

funktioniert RunAs(User,Password,Command) unter Windows 2000 ?

Habe folgenden Code gefunden der unter WinXP funktioniert - jedoch nicht unter Win2K :

Delphi-Quellcode:

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;

{------------
Emulate the RunAs function
--------------}

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), nil, PChar(Password), LOGON32_LOGON_INTERACTIVE,
LOGON32_PROVIDER_DEFAULT, hToken) then
  begin
     if CreateEnvironmentBlock(lpvEnv, hToken, 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;

und:

Delphi-Quellcode:

function CreateProcessAsLogon(const User, PW, Application, CmdLine: WideString):
  Boolean;
var
  si           : TStartupInfoW;
  pif          : TProcessInformation;
begin
  ZeroMemory(@si, sizeof(TStartupInfo));
  si.cb := SizeOf(TStartupInfoW);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := 1;
  Result := CreateProcessWithLogonW(PWideChar(User), nil, PWideChar(PW),
    LOGON_WITH_PROFILE, nil, PWideChar(Application +' '+CmdLine),
    CREATE_DEFAULT_ERROR_MODE, nil, nil, si, pif);
end;

Ich benötige RunAs unter Windows 2000 :gruebel:

KUBA

[MagicAndre1981]

ohne den Code getestet zu haben kann ich sagen dass es RunAs unter Windows 2000 gibt.

[Apollonius]

Wenn du uns jetzt noch sagtest, was an der Funktion nicht funktioniert... :glaskugel:

[kuba]

Zitat:

Zitat von MagicAndre1981

ohne den Code getestet zu haben kann ich sagen dass es RunAs unter Windows 2000 gibt.

Ja das weiss ich, o.g. Code funktioniert jedoch nicht unter Windows 2000, vermutlich gibt es unterschiede zu XP. Ich erhalte unter Win2K jedenfalls eine Schutzverletzung in der userenv.dll

KUBA

[Apollonius]

:glaskugel: Wo?

[kuba]

Zitat:

Zitat von Apollonius

:glaskugel: Wo?

Im Ereignisprotokoll :feuerchen:

kuba

[Dezipaitor]

Was er meint ist:
Zeige uns die Quelltextstelle, wo es fehlschlägt.

Stichwort: An den Prozess anhängen und debuggen

[kuba]

Verstehe...

Hab mein Delphi unter XP am laufen und teste meine Anwendung gerade unter Win2K, da bekomme ich bei beiden Routinen Probleme. Muss den Rechner nochmal starten und im Ereignisprotokoll nachschauen.

Dort steht etwas von: Die Registrierungseinstellungen konnten nicht direkt in das Benutzerprofil gespeichert werden, weil sie durch ein anderes Programm oder einen anderen Dienst bearbeitet wurden. Sie konnten nach 1 Versuchen gespeicher werden.

Am Bildschirm erscheint Die Dynamic Link Library advapi32 (userenv) wurde nicht im angegebenen Pfand ...blablabla... gefunden.

Die DLL´s sind natürlich vorhanden, aber wahrscheinlich passt das bei Win2K irgendwo nicht :?:


Ich erteile meinem angemeldeten User (bei dem mein Programm läuft) per Fernwartung Administratorrechte, das Programm "bemerkt" dass Administratorrechte vorhanden sind und startet per "RunAs" ein weiteres Programm welches Informationen in die Registry schreibt. Vermutlich klappt das bei Win2K nicht und ich muss den angemeldeten Benutzer erst abmelden bevor die Administratorrechte wirksam werden.

kuba