金满电器吧 关注:45贴子:1,871
  • 5回复贴,共1

'VBA 创建新进程并返回进程ID

只看楼主收藏回复

'VBA 创建新进程并返回进程ID


IP属地:浙江1楼2019-09-06 15:59回复
    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 String
    '保留。必须初始化为NULL
    lpDesktop As String
    '指定桌面名字,null是与当前桌面相关联
    lpTitle As String
    '控制台窗口名称,null是可执行文件的名字将用作窗口名
    dwX As Long
    dwY As Long
    '用于设定应用程序窗口在屏幕上应该放置的位置的x和y坐标(以像素为单位)。只有当子进程用CW_USEDEFAULT作为CreateWindow的x参数来创建它的第一个重叠窗口时,
    '才使用这两个坐标。若是创建控制台窗口的应用程序,这些成员用于指明控制台窗口的左上角
    dwXSize As Long
    dwYSize As Long
    '用于设定应用程序窗口的宽度和长度(以像素为单位)
    '当子进程将CW_USEDEFAULT用作CreateWindow的nWidth参数来创建它的第一个重叠窗口时,才使用这些值。
    dwXCountChars As Long
    dwYCountChars As Long
    '用于设定子应用程序的控制台窗口的宽度和高度(以字符为单位)
    dwFillAttribute As Long
    ''用于设定子应用程序的控制台窗口使用的文本和背景颜色
    dwFlags As Long
    '使用标志及含义
    wShowWindow As Integer
    '用于设定如果子应用程序初次调用的ShowWindow将SW_SHOWDEFAULT作为nCmdShow参数传递时,该应用程序的第一个重叠窗口应该如何出现。
    cbReserved2 As Integer
    '保留。必须被初始化为0
    lpReserved2 As Long
    '保留。必须被初始化为NULL
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
    '用于设定供控制台输入和输出用的缓存的句柄。按照默认设置,hStdInput用于标识键盘缓存,hStdOutput和hStdError用于标识控制台窗口的缓存
    End Type
    Private Type SECURITY_ATTRIBUTES
    nLength As Long
    '本类型长度
    lpSecurityDescriptor As Long
    '指向控制其共享的对象的安全描述符的指针,0为默认
    bInheritHandle As Long
    '1进程属性可以被以后线程进程继承,0不能
    End Type
    Private Const STARTF_USESTDHANDLES As Long = &H100&
    Private Const STARTF_USESHOWWINDOW As Long = &H1&
    Private Const INFINITE As Long = &HFFFF&
    Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
    End Enum
    Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
    End Enum
    '以上是进程函数变量
    Dim 进程句柄 As Long
    Dim 进程ID As Long
    '以上是进程变量


    IP属地:浙江2楼2019-09-06 15:59
    回复
      #If Win64 Then
      '这是64位的API声明
      Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
      '查找窗口并返回窗口句柄
      Private Declare PtrSafe 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
      '创建新进程
      Private Declare PtrSafe Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
      '创建匿名读写管道句柄
      #Else
      '这是32位的API声明
      Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
      '查找窗口并返回窗口句柄
      Private 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
      '创建新进程
      Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
      '创建匿名读写管道句柄
      #End If


      IP属地:浙江3楼2019-09-06 16:00
      回复
        Function 创建进程并返回句柄公共接口(ByVal 执行模块 As String, ByVal 命令 As String) As Long
        On Error Resume Next
        ''忽略错误继续执行VBA代码
        Dim 进程属性 As SECURITY_ATTRIBUTES
        Dim 线程属性 As SECURITY_ATTRIBUTES
        Dim 成功否 As Long
        Dim 进程读句柄 As Long
        Dim 进程写句柄 As Long
        Dim 线程读句柄 As Long
        Dim 线程写句柄 As Long
        Dim 新进程是否继承句柄 As Long
        Dim 进程附加标志 As Long
        Dim 进程环境设置 As Variant
        Dim 工作绝对路径 As String
        Dim 主窗口特性 As STARTUPINFO
        Dim 返回进程信息 As PROCESS_INFORMATION
        With 进程属性
        .bInheritHandle = 1
        '1进程属性可以被以后进程继承,0不能
        .lpSecurityDescriptor = 0
        '指向控制其共享的对象的安全描述符的指针,0为默认
        .nLength = Len(进程属性)
        '本类型长度
        End With
        '以上是进程属性
        成功否 = CreatePipe(进程读句柄, 进程写句柄, 进程属性, 0&)
        If 成功否 = 0 Then
        Debug.Print "创建匿名管道失败"
        创建进程并返回句柄公共接口 = 0&
        Exit Function
        End If
        With 线程属性
        .bInheritHandle = 1
        '1线程属性可以被以后线程继承,0不能
        .lpSecurityDescriptor = 0
        '指向控制其共享的对象的安全描述符的指针,0为默认
        .nLength = Len(线程属性)
        '本类型长度
        End With
        '以上是线程属性
        成功否 = CreatePipe(线程读句柄, 线程写句柄, 进程属性, 0&)
        If 成功否 = 0 Then
        Debug.Print "创建匿名管道失败"
        创建进程并返回句柄公共接口 = 0&
        Exit Function
        End If
        新进程是否继承句柄 = 1&
        '1为继承句柄,0不能
        '进程优先级:这个进程没有特殊的任务调度要求
        进程环境设置 = 0&
        '新进程使用调用进程的环境
        With 主窗口特性
        .cb = 68
        .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
        'Or 256
        '使用标志及含义
        .wShowWindow = 1
        '用于设定如果子应用程序初次调用的ShowWindow将SW_SHOWDEFAULT作为nCmdShow参数传递时,该应用程序的第一个重叠窗口应该如何出现。
        '.hStdInput = 进程读句柄
        .hStdOutput = 进程写句柄
        '用于设定供控制台输入和输出用的缓存的句柄。按照默认设置,hStdInput用于标识键盘缓存,hStdOutput和hStdError用于标识控制台窗口的缓存
        End With
        进程附加标志 = 32&
        'Or CREATE_DEFAULT_ERROR_MODE
        工作绝对路径 = vbNullString
        '新进程将使用与调用进程相同的驱动器和目录
        创建进程并返回句柄公共接口 = 创建进程并返回句柄完整(执行模块, 命令, 进程属性, 线程属性, 新进程是否继承句柄, 进程附加标志, 进程环境设置, 工作绝对路径, 主窗口特性, 返回进程信息)
        Debug.Print " 创建进程并返回句柄= " & 创建进程并返回句柄公共接口
        End Function


        IP属地:浙江4楼2019-09-06 16:01
        回复
          Private Function 创建进程并返回句柄完整(ByVal 执行模块 As String, ByVal 命令 As String, 进程属性 As SECURITY_ATTRIBUTES, 线程属性 As SECURITY_ATTRIBUTES, ByVal 新进程是否继承句柄 As Long, ByVal 进程附加标志 As Long, 进程环境设置 As Variant, ByVal 工作绝对路径 As String, 主窗口特性 As STARTUPINFO, 返回进程信息 As PROCESS_INFORMATION) As Long
          On Error Resume Next
          '忽略错误继续执行VBA代码
          Dim 主线程句柄 As Long
          Dim 主线程ID As Long
          命令 = 命令 & vbNullChar
          '在字符串后面加NULL
          创建进程并返回句柄完整 = CreateProcess(执行模块, 命令, 进程属性, 线程属性, 1&, 进程附加标志, ByVal 0&, 工作绝对路径, 主窗口特性, 返回进程信息)
          进程句柄 = 返回进程信息.hProcess
          Debug.Print "进程句柄 = " & 进程句柄
          进程ID = 返回进程信息.dwProcessId
          Debug.Print "进程ID = " & 进程ID
          主线程句柄 = 返回进程信息.hProcess
          Debug.Print "主线程句柄 = " & 主线程句柄
          主线程ID = 返回进程信息.hProcess
          Debug.Print "主线程ID = " & 主线程ID
          Debug.Print " 创建进程并返回句柄= " & 创建进程并返回句柄完整
          创建进程并返回句柄完整 = 进程ID
          End Function


          IP属地:浙江5楼2019-09-06 16:02
          回复
            Private Sub 试验_Click()
            On Error Resume Next
            '忽略错误继续执行VBA代码
            Dim a As Long
            a = 0
            接口 = vbNullString
            命令行 = "excel"
            a =创建进程并返回句柄公共接口(接口, 命令行)
            '("cmd", "cmd")
            Debug.Print a
            End Sub
            '运行试验_Click终于成功,就是CMD命令闪退,excel 命令倒是可以启动,但windows任务管理器里找不到


            IP属地:浙江6楼2019-09-06 16:02
            回复