Tipp 0533 Anwendung im Admin-Modus ausführen
Autor/Einsender:
Datum:
  Frederik Schildmann
24.06.2007
Entwicklungsumgebung:   VB 6
Ab Windows NT 4.0 besitzen alle neueren Betriebssysteme eine Rechte-Verwaltung, die es ermöglicht, unterschiedlichen Usern auch unterschiedliche Nutzer-Rechte einzuräumen. Nun kommt es allerdings vor, dass ein Programm Rechte benötigt über die der betreffende User nicht verfügt (z.B. Schreibrechte für die System-Registrierung).
Basierend auf dem Artikel How to start a process as another user from Visual Basic der MSDN ermöglicht dieser Tipp die Ausführung einer beliebigen Anwendung in einem anderen User-Modus oder auch im Admin-Modus, ohne das System in einem dieser Modi neu starten zu müssen. Hierzu ist dann nur noch der korrekte User-Name sowie das entsprechende Passwort notwendig.
Bitte beachten
Die nachfolgenden Codes sind zum Teil lediglich Code-Schnipsel. Verwenden Sie bitte das voll funktionsfähige Downloadprojekt, das neben dem gesamten Code auch noch die entsprechenden Kommentierungen enthält.
Code im Codebereich des Moduls module1
 
Option Explicit

Public Function GetDomain() As String
  On Error Resume Next

   'Frühes Binden (early binding)
  Dim objWSHNetwork As New IWshRuntimeLibrary.WshNetwork

   'Aktuelle Domäne
  GetDomain = objWSHNetwork.UserDomain
  Set objWSHNetwork = Nothing
End Function

 'VB-fun.de Kurztipp (Pfad der Anwendung korrekt ermitteln)
Function ApplicationPath() As String
  ApplicationPath = App.Path &
       IIf(Right$(App.Path, 1) = "\", "", "\")
End Function
 
Code im Codebereich des Moduls modComputername
 
Option Explicit

Private Declare Function GetComputerName Lib "kernel32" Alias _
      "GetComputerNameA" (ByVal lpBuffer As String, nSize _
      As Long) As Long

Private Const MAX_COMPUTERNAME_LENGTH = 15
Public strPCName As String

Sub GetCompName()
  Dim strBuffer As String
  Dim lngResult As Long
  Dim nSize     As Long

  strBuffer = String$(MAX_COMPUTERNAME_LENGTH + 1, 0)
  nSize = MAX_COMPUTERNAME_LENGTH + 1

  lngResult = GetComputerName(strBuffer, nSize)
  If lngResult = 1 Then
    strPCName = Left$(strBuffer, nSize)
  End If
End Sub
 
Aus dem folgenden Modul ist hier lediglich der Codeteil zu Windows 2000 publiziert. Das Download-Beispiel enthält jedoch den gesamten Code.
Code im Codebereich des Moduls modRunAsAdmin
 
Option Explicit

Private Const CREATE_DEFAULT_ERROR_MODE = &H4000000

Private Const LOGON_WITH_PROFILE = &H1
Private Const LOGON_NETCREDENTIALS_ONLY = &H2
Private Const LOGON32_LOGON_INTERACTIVE = 2
Private Const LOGON32_PROVIDER_DEFAULT = 0

Private Type STARTUPINFO
  cb As Long
  lpReserved As Long
  lpDesktop As Long
  lpTitle As Long
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Long
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type

Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessId As Long
  dwThreadId As Long
End Type

Private Declare Function LogonUser Lib "advapi32.dll" Alias _
      "LogonUserA" (ByVal lpszUsername As String, _
      ByVal lpszDomain As String, ByVal lpszPassword As String, _
      ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, _
      phToken As Long) As Long

Private Declare Function CreateProcessAsUser Lib "advapi32.dll" _
      Alias "CreateProcessAsUserA" (ByVal hToken As Long, _
      ByVal lpApplicationName As Long, _
      ByVal lpCommandLine As String, _
      ByVal lpProcessAttributes As Long, _
      ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, _
      ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, _
      ByVal lpCurrentDirectory As String, _
      lpStartupInfo As STARTUPINFO, _
      lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CreateProcessWithLogonW Lib _
      "advapi32.dll" (ByVal lpUsername As String, _
      ByVal lpDomain As String, ByVal lpPassword As String, _
      ByVal dwLogonFlags As Long,
      ByVal lpApplicationName As Long, _
      ByVal lpCommandLine As String,
      ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, _
      ByVal lpCurrentDirectory As String, _
      ByRef lpStartupInfo As STARTUPINFO, _
      ByRef lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" _
      (ByVal hObject As Long) As Long

Private Declare Function SetErrorMode Lib "kernel32.dll" _
      (ByVal uMode As Long) As Long

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Declare Function GetVersionExA Lib "kernel32.dll" _
    (lpVersionInformation As OSVERSIONINFO) As Integer

Private Const VER_PLATFORM_WIN32_NT = &H2

Public Function W2KRunAsUser(ByVal UserName As String, _
     ByVal Password As String, _
     ByVal DomainName As String, _
     ByVal CommandLine As String, _
     ByVal CurrentDirectory As String) As Long

  Dim si As STARTUPINFO
  Dim pi As PROCESS_INFORMATION

  Dim wUser As String
  Dim wDomain As String
  Dim wPassword As String
  Dim wCommandLine As String
  Dim wCurrentDir As String

  Dim Result As Long

  si.cb = Len(si)

  wUser = StrConv(UserName + Chr$(0), vbUnicode)
  wDomain = StrConv(DomainName + Chr$(0), vbUnicode)
  wPassword = StrConv(Password + Chr$(0), vbUnicode)
  wCommandLine = StrConv(CommandLine + Chr$(0), vbUnicode)
  wCurrentDir = StrConv(CurrentDirectory + Chr$(0), vbUnicode)

  Result = CreateProcessWithLogonW(wUser, wDomain, wPassword, _
         LOGON_WITH_PROFILE, 0&, wCommandLine, _
         CREATE_DEFAULT_ERROR_MODE, 0&, wCurrentDir, si, pi)

  If Result <> 0 Then
     CloseHandle pi.hThread
     CloseHandle pi.hProcess
     W2KRunAsUser = 0
     Unload frmUserPassword
     End
  Else
     MsgBox "Der Benutzername oder das Kennwort sind nicht _
         korrekt." & vbCrLf & "Bitte versuchen sie es erneut!", _
         vbCritical + vbOKOnly, "Falsche Benutzerinformationen"
     frmUserPassword.txtUser.SetFocus
  End If

End Function

Public Function RunAsUser(ByVal UserName As String, _
     ByVal Password As String, ByVal DomainName As String, _
     ByVal CommandLine As String, _
     ByVal CurrentDirectory As String) As Long

  Dim w2kOrAbove As Boolean
  Dim osinfo As OSVERSIONINFO
  Dim Result As Long
  Dim uErrorMode As Long

  osinfo.dwOSVersionInfoSize = Len(osinfo)
  osinfo.szCSDVersion = Space$(128)
  GetVersionExA osinfo
  w2kOrAbove = (osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
               osinfo.dwMajorVersion >= 5)
  If (w2kOrAbove) Then
     Result = W2KRunAsUser(UserName, Password, DomainName, _
              CommandLine, CurrentDirectory)
  Else
     Result = NT4RunAsUser(UserName, Password, DomainName, _
              CommandLine, CurrentDirectory)
  End If
  RunAsUser = Result
End Function
 
Code im Codebereich der Form UserPassword
 
Option Explicit

Dim strPath As String

Private Sub cmdLookProg_Click()
  frmCommonDialog.Show
End Sub

Private Sub cmdRun_Click()
  RunAsUser txtUser.Text, txtPassword.Text, cmbDomainPCName, _
       strApp.Text, strPath
End Sub

Private Sub Form_Load()
    ' Pfad der Anwendung
  strPath = ApplicationPath
    ' Rechnernamen und ggfls. Domäne ermitteln
  CompNameDomain
End Sub

Private Sub CompNameDomain()
  modComputername.GetCompName
  If GetDomain = strPCName Then
     cmbDomainPCName.AddItem (strPCName)
     cmbDomainPCName.ListIndex = 0
  Else
     cmbDomainPCName.AddItem (strPCName)
     cmbDomainPCName.AddItem (GetDomain)
  End If
End Sub

Private Sub strApp_Change()
  cmdRun.Enabled = IIf(strApp.Text <> vbNullString, True, False)
End Sub
 
Weitere Links zum Thema
How to start a process as another user from Visual Basic
Hinweis
Das Download-Beispiel ist entsprechend kommentiert. Der Tipp basiert auf dem vorgenannten MSDN-Beispiel.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (9,8 kB) Downloads bisher: [ 649 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 26. Juni 2011