CreateProcessWithLogon

Aus API-Wiki
Zur Navigation springenZur Suche springen

Die API-Funktion CreateProcessWithLogon startet einen neuen Prozess unter einem anderen Benutzerkonto.

Declare Function CreateProcessWithLogonW Lib "Advapi32" ( _
                 ByVal lpUsername As Long, _
                 ByVal lpDomain As Long, _
                 ByVal lpPassword As Long, _
                 ByVal dwLogonFlags As Long, _
                 ByVal lpApplicationName As Long, _
                 ByVal lpCommandLine As Long, _
                 ByVal dwCreationFlags As Long, _
                 ByVal lpEnvironment As Long, _
                 ByVal lpCurrentDirectory As Long, _
                 ByRef lpStartupInfo As STARTUPINFO, _
                 ByRef lpProcessInfo As PROCESS_INFORMATION) As Long


Parameter

lpUsername

Ein Zeiger auf den Benutzernamen unter dem der Prozess gestartet werden soll.

lpDomain

Ein Zeiger auf den Namen der Domäne in dem das Benutzerkonto vorhanden ist.

lpPassword

Ein Zeiger auf das Passwort des Benutzerkontos.

dwLogonFlags

Flags.

lpApplicationName

lpCommandLine

dwCreationFlags

lpEnvironment

lpCurrentDirectory

lpStartupInfo

STARTUPINFO Struktur.

lpProcessInfo

PROCESS_INFORMATION Struktur.

Rückgabe(n)

Die Funktion gibt einen Wert des Types Long ungleich 0 bei Erfolg, den Wert 0 bei Misserfolg zurück.


Beispiel

Option Explicit
Private Const LOGON_WITH_PROFILE = &H1&
Private Const CREATE_DEFAULT_ERROR_MODE = &H4000000
Private Const CREATE_NEW_CONSOLE = &H10&
Private Const CREATE_NEW_PROCESS_GROUP = &H200&

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

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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Declare Function CreateProcessWithLogonW Lib "Advapi32" (ByVal lpUsername As Long, _
        ByVal lpDomain As Long, ByVal lpPassword As Long, ByVal dwLogonFlags As Long, _
        ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, _
        ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
        ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, _
        lpProcessInfo As PROCESS_INFORMATION) As Long

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

Public Sub RunAs(UserName As String, DomainName As String, Password As String, ByVal CommandLine As String)
    Dim sApplicationName As String
    Dim sCurrentDirectory As String
    Dim StartInfo As STARTUPINFO, ProcessInfo As PROCESS_INFORMATION
    Dim lRet As Long
    
    sApplicationName = vbNullString
    sCurrentDirectory = vbNullString
    StartInfo.cb = LenB(StartInfo)
    StartInfo.dwFlags = 0&
    
    If Left(CommandLine, 1) <> Chr(34) Then
        'aus sicherheitsgründen unter Anführungszeichen setzen
        CommandLine = Chr(34) & CommandLine & Chr(34)
    End If
    
    If CreateProcessWithLogonW(StrPtr(UserName), StrPtr(DomainName), StrPtr(Password), _
            LOGON_WITH_PROFILE, StrPtr(sApplicationName), StrPtr(CommandLine), _
            CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP, _
            ByVal 0&, StrPtr(sCurrentDirectory), StartInfo, ProcessInfo) = 0 Then
        Err.Raise 514, , "Failed to run " & vbCrLf & CommandLine
    End If
    
    CloseHandle ProcessInfo.hThread
    CloseHandle ProcessInfo.hProcess
End Sub

Quelle(n)

  • MSDN US-Libary