Question

我有一个运行下一个vba代码的Outlook 2016（64位），当函数退出时，Outlook崩溃。该api执行正常，我看到记事本在另一个用户下启动。

Sub TestRunAs()

If User_RunAs("jonny", "JonnysPassword", "lvd.be", "c:\windows\notepad.exe") Then
  MsgBox ("Ok, executed!")
End If

End Sub

这是函数；

Public Function User_RunAs(ByVal sUserName As String, ByVal sPassword As String, ByVal sDomain As String, ByVal sCommand As String) As Boolean

Dim lReturn             As Long
Dim sApplication        As String
Dim sDirectory          As String
Dim tPInfo              As PROCESS_INFORMATION
Dim tStart              As STARTUPINFO

'/* default struct
sApplication = vbNullString
sDirectory = vbNullString
tStart.Cb = LenB(tStart)
tStart.dwFlags = 0&

lReturn = CreateProcessWithLogonW(StrPtr(sUserName), StrPtr(sDomain), StrPtr(sPassword), &H1, _
                                  0&, StrPtr(sCommand), _
                                  DEFAULT_LOGON, 0&, StrPtr(sDirectory), _
                                  tStart, tPInfo)
' 1st row                         LongPtr            LongPtr          LongPtr            Long
' 2nd row                         Long LongPtr
' 3rd row                         Long           Long LongPtr
' 4th row                         Structure Structure

'/* success
If Not lReturn = 0 Then
    User_RunAs = True
End If

'/* cleanup
If tPInfo.hProcess <> 0 Then
    CloseHandle tPInfo.hThread
    CloseHandle tPInfo.hProcess
End If
End Function

定义如下；

'Types used by function User_RunAs
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 Long
    hStdInput                                           As Long
    hStdOutput                                          As Long
    hStdError                                           As Long
End Type
Private Declare PtrSafe Function CreateProcessWithLogonW Lib "advapi32" (ByVal lpUserName As LongPtr, ByVal lpDomain As LongPtr, ByVal lpPassword As LongPtr, ByVal dwLogonFlags As Long, _
                                                                     ByVal         lpApplicationName As Long, ByVal lpCommandLine As LongPtr, _
                                                                     ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As LongPtr, _
                                                                     ByRef         lpStartupInfo As STARTUPINFO, ByRef lpProcessInfo As PROCESS_INFORMATION) As Long

即使在api调用后立即退出该函数，Outlook也会因下一个报告而崩溃；

Answer 1

在阅读有关不同位版本的兼容性的MS文档时，我发现在通过Long的结构上，必须用LongPtr代替。参见https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2010/ee691831(v=office.14)

例如传递的结构

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

现在必须是

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

是什么使Outlook在执行CreateProcessWithLogonW之后崩溃？

1 个答案: