WinAPI в Excel

[Shizuku]

Не получается запустить процесс через CreateProcess(). Хотя я добросовестно описала все необходимые функции и структуры. Помогите, пожалуйста, мой исходник прилагается.

Код: Выделить всё


Option Explicit

'   Объявление 32-битной функции Windows API
Declare Function CreatePipe Lib "kernel32" _
(phReadPipe As Long, phWritePipe As Long, _
lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long

Declare Function ResumeThread Lib "kernel32" _
(ByVal hThread As Long) As Long

Declare Function SetThreadPriority Lib "kernel32" _
(ByVal hThread As Long, ByVal nPriority As Long) As Long

Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
' *** End Declare Functions ***
     
Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Boolean
End Type

Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type
       
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 Byte
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type

Type hPipes
hPipe(1 To 6) As Long
End Type

'   The handle is invalid.
Public Const ERROR_INVALID_HANDLE = 6&
Public Const NORMAL_PRIORITY_CLASS = &H20
Public Const IDLE_PRIORITY_CLASS = &H40
Public Const HIGH_PRIORITY_CLASS = &H80
Public Const REALTIME_PRIORITY_CLASS = &H100
'  Dual Mode API below this line. Dual Mode Types also included.

Public Const STARTF_USESHOWWINDOW = &H1
Public Const STARTF_USESIZE = &H2
Public Const STARTF_USEPOSITION = &H4
Public Const STARTF_USECOUNTCHARS = &H8
Public Const STARTF_USEFILLATTRIBUTE = &H10
Public Const STARTF_RUNFULLSCREEN = &H20        '  ignored for non-x86 platforms
Public Const STARTF_FORCEONFEEDBACK = &H40
Public Const STARTF_FORCEOFFFEEDBACK = &H80
Public Const STARTF_USESTDHANDLES = &H100

' ShowWindow() Commands
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
Const H_IN_READ = 1
Const H_IN_WRITE = 2
Const H_OUT_READ = 3
Const H_OUT_WRITE = 4
Const H_ERR_READ = 5
Const H_ERR_WRITE = 6

Dim Pipe As hPipes
Dim ProcessInfo As PROCESS_INFORMATION


Public Function CreateHiddenConsoleProcess(szChildName As String, _
         ProcPriority As Double, ThreadPriority As Integer) As Boolean
Dim fCreated As Boolean
Dim si As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim s As SECURITY_ATTRIBUTES
' Initialize handles
'ProcessInfo.hProcess = ERROR_INVALID_HANDLE
'ProcessInfo.hThread = ERROR_INVALID_HANDLE

sa.nLength = Len(sa)
sa.bInheritHandle = True
sa.lpSecurityDescriptor = 0

' process startup information
'ZeroMemory(Pointer(@si), sizeof(si));
si.cbReserved2 = 0&
si.lpReserved = 0&
si.dwFillAttribute = 0&
si.dwX = 0&
si.dwY = 0&
si.dwXSize = 0&
si.dwYSize = 0&
si.dwXCountChars = 0&
si.dwYCountChars = 0&
si.hStdError = 0&
si.hStdInput = 0&
si.hStdOutput = 0&
si.lpDesktop = 0&
si.lpTitle = 0&
si.cb = Len(si)
si.dwFlags = STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES
si.wShowWindow = SW_SHOW
'Create a child process
' try
    fCreated = CreateProcess(0&, szChildName, s, s, True, _
    ProcPriority, _
    0&, 0&, si, ProcessInfo)
    On Error GoTo err_cp
' except
GoTo complete
err_cp:
    fCreated = False

complete:
If Not fCreated Then
'GoTo error
End If
'Result = True
'Call ResumeThread(ProcessInfo.hThread)
Call SetThreadPriority(ProcessInfo.hThread, ThreadPriority)
ProcessInfo.hThread = 0
Exit Function
'-----------------------------------------------------
error:
    Pipe.hPipe(1) = 0
    ProcessInfo.hProcess = 0
    ProcessInfo.hThread = 0
    ProcessInfo.hProcess = ERROR_INVALID_HANDLE
    ProcessInfo.hThread = ERROR_INVALID_HANDLE
' Result = False
End Function

Public Sub test()
'Dim g As Double
'g = Shell("calc", vbNormalFocus)
Dim path As String
path = "calc" & 0&
Call CreateHiddenConsoleProcess(path, NORMAL_PRIORITY_CLASS, NORMAL_PRIORITY_CLASS)
End Sub


[GSerg]

А что планируется получить в итоге?

[Shizuku]

to GSerg> Просто нужно запустить программу, путь к которой передаётся в качестве параметра в переменной path. Например калькулятор. Процесс будет создаваться с определённым приоритетом, которой тоже можно задать.

Но нужен именно WinAPI, shell() не годится.

[GSerg]

Стрянно, стрянно...

Код: Выделить всё

Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, lpProcessAttributes As any, _
lpThreadAttributes As any, ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long



Dim si As STARTUPINFO, pi as PROCESS_INFORMATION

si.cb=len(si)
si.dwFlags = STARTF_USESHOWWINDOW
si.wShowWindow = SW_SHOW

CreateProcess vbNullstring, szChildName, byval 0&, byval 0&, 1, ProcPriority, byval 0&, vbnullstring, si, pi

SetThreadPriority pi.hThread, ThreadPriority

CloseHandle pi.hThread
CloseHandle pi.hProcess