Что вызывает сбой Outlook после выполнения CreateProcessWithLogonW? - PullRequest
0 голосов
/ 29 ноября 2018

У меня Outlook 2016 (64-разрядная версия), выполняющий следующий код VBA, и при выходе из функции 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 выходит из строя со следующим отчетом;

enter image description here

1 Ответ

0 голосов
/ 30 ноября 2018

При чтении документации 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...