Win7下的VB程序调用CreateProcessAsUser创建进程失败

Question

VB工程文件通过CreateProcessAsUser创建进程，在XP下成功，在Win7下失败，什么原因？

Answer 1

通过GetLastError获得的值是0，但是CreateProcessAsUser返回结果为false。

Answer 2

通过窗体调用RunProcess方法，call RunProcess("aaaa.exe"),aaaa.exe是有窗体的可执行程序，代码如下：
Option ExplicitPublic Enum SECURITY_IMPERSONATION_LEVEL
    SecurityAnonymous
    SecurityIdentification
    SecurityImpersonation
    SecurityDelegation
End EnumPrivate Enum TOKEN_TYPE
    TokenPrimary = 1
    TokenImpersonation
End EnumPublic Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End TypePublic Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    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 TypePublic Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End TypePublic Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260 '[MAX_PATH]End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As BooleanPrivate Declare Function WTSGetActiveConsoleSessionId Lib "kernel32.dll" () As IntegerPrivate Declare Function WTSQueryUserToken _
                Lib "Wtsapi32.dll" (ByVal sessionId As Long, _
                                    phToken As Long) As Boolean
Private Declare Function DuplicateTokenEx _
                Lib "advapi32.dll" (ByVal hExistingToken As Long, _
                                    ByVal dwDesiredAccess As Long, _
                                    lpTokenAttributes As SECURITY_ATTRIBUTES, _
                                    ImpersonationLevel As SECURITY_IMPERSONATION_LEVEL, _
                                    ByVal TokenType As TOKEN_TYPE, _
                                    phNewToken As Long) As BooleanPrivate Declare Function CreateEnvironmentBlock _
                Lib "Userenv.dll" (lpEnvironment As Long, _
                                   ByVal hToken As Long, _
                                   ByVal bInherit As Boolean) As Boolean
                                   
Private Declare Function CreateProcessAsUser _
                Lib "advapi32.dll" _
                Alias "CreateProcessAsUserA" (ByVal hToken As Long, _
                                              ByVal lpApplicationName As String, _
                                              ByVal lpCommandLine As String, _
                                              ByVal lpProcessAttributes As Long, _
                                              ByVal lpThreadAttributes As Long, _
                                              ByVal bInheritHandles As Boolean, _
                                              ByVal dwCreationFlags As Long, _
                                              ByVal lpEnvironment As String, _
                                              ByVal lpCurrentDirectory As String, _
                                              lpStartupInfo As STARTUPINFO, _
                                              lpProcessInformation As PROCESS_INFORMATION) As Long 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As BooleanPrivate Declare Function GetLastError Lib "kernel32" () As LongPrivate Const MAXIMUM_ALLOWED = 25
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_IMPERSONATE = &H4
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_ADJUST_GROUPS = &H40
Private Const TOKEN_ADJUST_DEFAULT = &H80
Private Const TOKEN_ADJUST_SESSIONID = &H100
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                        TOKEN_ASSIGN_PRIMARY Or _
                        TOKEN_DUPLICATE Or _
                        TOKEN_IMPERSONATE Or _
                        TOKEN_QUERY Or _
                        TOKEN_QUERY_SOURCE Or _
                        TOKEN_ADJUST_PRIVILEGES Or _
                        TOKEN_ADJUST_GROUPS Or _
                        TOKEN_ADJUST_DEFAULT Or _
                        TOKEN_ADJUST_SESSIONID)Private Const TOKEN_READ = (STANDARD_RIGHTS_READ Or TOKEN_QUERY)
Private Const TOKEN_WRITE = (STANDARD_RIGHTS_WRITE Or _
                        TOKEN_ADJUST_PRIVILEGES Or _
                        TOKEN_ADJUST_GROUPS Or _
                        TOKEN_ADJUST_DEFAULT)Private Const TOKEN_EXECUTE = STANDARD_RIGHTS_EXECUTE
Private Const INVALID_HANDLE_VALUE = -1
Const TH32CS_SNAPheaplist = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPthread = &H4
Const TH32CS_SNAPmodule = &H8
Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodulePrivate Const PROCESS_QUERY_INFORMATION = &H400
Private Function GetTokenByName(hToken As Long, ByVal lpName As String) As Boolean    If Len(lpName) = 0 Then
        GetTokenByName = False
        Exit Function
    End If    Dim hProcessSnap As Long
    Dim hToken1      As Long
    
    Dim ares         As Boolean
    Dim pe32         As PROCESSENTRY32
    Dim theloop      As Long
    Dim dotExePos    As Long
    Dim exename      As String    hProcessSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)    myDebuglog "hProcessSnap:" & hProcessSnap    If (hProcessSnap = INVALID_HANDLE_VALUE) Then
        GetTokenByName = False
        Exit Function
    End If    pe32.dwSize = Len(pe32)
      
    theloop = ProcessFirst(hProcessSnap, pe32)
    
    While theloop <> 0
        
        exename = LCase(pe32.szExeFile)        dotExePos = InStr(exename, ".exe")        If dotExePos > 0 Then
            exename = Left(exename, dotExePos + 3)
        End If        dotExePos = InStr(1, exename, Chr$(0))        If dotExePos > 0 Then
            exename = Left(exename, dotExePos - 1)
        End If
        
        If exename = LCase(lpName) Then
            
            Dim hProcess As Long
            hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, pe32.th32ProcessID)
            ares = OpenProcessToken(hProcess, TOKEN_ALL_ACCESS, hToken)            If ares Then
                msgbox "OpenProcessToken success!"
            Else
                msgbox "error:" & GetLastError
            
            End If
 
            Call CloseHandle(hProcessSnap)
            GetTokenByName = True
            Exit Function
        End If        theloop = ProcessNext(hProcessSnap, pe32)
    Wend
    
    GetTokenByName = False
    Call CloseHandle(hProcessSnap)End Function
    
Public Function RunProcess(ByVal lpImage As String) As Boolean
 On Error GoTo err0
    If Len(lpImage) = 0 Then
        RunProcess = False
        Exit Function
    End If    Dim hToken As Long
    If Not GetTokenByName(hToken, "EXPLORER.EXE") Then
        RunProcess = False
        Exit Function
    End If
    
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION    
    si.cb = Len(si)
    si.lpDesktop = "winsta0\default"
    
    Dim bResult As Boolean
    bResult = CreateProcessAsUser(hToken, lpImage, vbNullString, 0, 0, False, NORMAL_PRIORITY_CLASS, 0, vbNullString, si, pi)
    
    CloseHandle (hToken)
    
    If bResult Then
        msgbox "CreateProcessAsUser   ok!"
    Else
        msgbox "CreateProcessAsUser   false!"
    End If
    RunProcess = bResult
err0:
    msgbox Err.Description
    
End Function

Answer 3

你的Windows登录用户是不是系统管理员？如果不是，建议你用系统管理员登录一次试一下。

Answer 4

创建进程的话，在win7下，administrator权限不一定够的。