stdVBA
stdVBA copied to clipboard
Published
20 hours ago •
sancarn
sancarn
stdProcess - Use CreateProcess() instead of Shell()
Currently we are using Shell() for simplicity. We have built some (bodge) 64-bit code as follows:
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Private 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 LongPtr
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessId As Long
dwThreadId As Long
End Type
Public Enum ECreationFlags
CREATE_BREAKAWAY_FROM_JOB = &H1000000
CREATE_DEFAULT_ERROR_MODE = &H4000000
CREATE_NEW_CONSOLE = &H10&
CREATE_NEW_PROCESS_GROUP = &H200&
CREATE_NO_WINDOW = &H8000000
CREATE_PROTECTED_PROCESS = &H40000
CREATE_PRESERVE_CODE_AUTHZ_LEVEL = &H2000000
CREATE_SECURE_PROCESS = &H400000
CREATE_SEPARATE_WOW_VDM = &H800&
CREATE_SHARED_WOW_VDM = &H1000&
CREATE_SUSPENDED = &H4&
CREATE_UNICODE_ENVIRONMENT = &H400&
DEBUG_ONLY_THIS_PROCESS = &H2&
DEBUG_PROCESS = &H1&
DETACHED_PROCESS = &H8&
EXTENDED_tStartupInfo_PRESENT = &H80000
INHERIT_PARENT_AFFINITY = &H10000
PRIORITY_CLASS_NORMAL = &H20&
PRIORITY_CLASS_IDLE = &H40&
PRIORITY_CLASS_HIGH = &H80&
End Enum
Public Enum EStartupFlags
STARTF_FORCEONFEEDBACK = &H40&
STARTF_FORCEOFFFEEDBACK = &H80&
STARTF_PREVENTPINNING = &H2000&
STARTF_RUNFULLSCREEN = &H20&
STARTF_TITLEISAPPID = &H1000&
STARTF_TITLEISLINKNAME = &H800&
STARTF_UNTRUSTEDSOURCE = &H8000&
STARTF_USECOUNTCHARS = &H8&
STARTF_USEFILLATTRIBUTE = &H10&
STARTF_USEHOTKEY = &H200&
STARTF_USEPOSITION = &H4&
STARTF_USESHOWWINDOW = &H1&
STARTF_USESIZE = &H2&
STARTF_USESTDHANDLES = &H100&
End Enum
Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
ByRef lpProcessAttributes As SECURITY_ATTRIBUTES, _
ByRef lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByRef lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
ByRef lpStartupInfo As STARTUPINFO, _
ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare PtrSafe Function SuspendThread Lib "kernel32" (ByVal hThread As LongPtr) As Long
Private Declare PtrSafe Function ResumeThread Lib "kernel32" (ByVal hThread As LongPtr) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function DebugActiveProcess Lib "kernel32" (ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function DebugActiveProcessStop Lib "kernel32" (ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function WinApi_CreateProcess(strCommandLine As String, Optional strCurrentDirectory As String = vbNullString) As Long
If strCurrentDirectory = vbNullString Then
strCurrentDirectory = ThisWorkbook.Path
End If
Dim sap As SECURITY_ATTRIBUTES: sap.nLength = Len(sap)
Dim sat As SECURITY_ATTRIBUTES: sat.nLength = Len(sat)
Dim si As STARTUPINFO: si.cb = Len(si)
si.wShowWindow = STARTF_USESHOWWINDOW
Dim pi As PROCESS_INFORMATION
Debug.Print Err.LastDllError ' 0 => ERROR_SUCCESS
Dim dwResult As Long: dwResult = CreateProcess(vbNullString, strCommandLine, sap, sat, 0, PRIORITY_CLASS_NORMAL, 0, strCurrentDirectory, si, pi)
WinApi_CreateProcess = pi.dwProcessId
End Function
which appears to be able to create cmd.exe processes correctly, however any application with UI like mspaint.exe, explorer.exe and calc.exe are all unopenable using this function...
Need to figure out what we are missing and integrate this into stdProcess
Edit: Actually, notepad.exe works fine! Still not sure about the others...
