Const NORMAL_PRIORITY_CLASS = &H20&
'Return code/value Description
'0x00008000 Process that has priority above NORMAL_PRIORITY_CLASS but below HIGH_PRIORITY_CLASS.
'0x00004000 Process that has priority above IDLE_PRIORITY_CLASS but below NORMAL_PRIORITY_CLASS.
'0x00000080 Process that performs time-critical tasks that must be executed immediately for it to run correctly. The threads of a high-priority class process preempt the threads of normal or idle priority class processes. An example is the Task List, which must respond quickly when called by the user, regardless of the load on the operating system. Use extreme care when using the high-priority class, because a high-priority class CPU-bound application can use nearly all available cycles.
'0x00000040 Process whose threads run only when the system is idle and are preempted by the threads of any process running in a higher priority class. An example is a screen saver. The idle priority class is inherited by child processes.
'0x00000020 Process with no special scheduling needs.
'0x00000100 Process that has the highest possible priority. The threads of a real-time priority class process preempt the threads of all other processes, including operating system processes performing important tasks. For example, a real-time process that executes for more than a very brief interval can cause disk caches not to flush or cause the mouse to be unresponsive.
Const STARTF_USESTDHANDLES = &H100&
Const STARTF_USESHOWWINDOW = &H1
'0x00000040 Indicates that the cursor is in feedback mode for two seconds after CreateProcess is called. The Working in Background cursor is displayed (see the Pointers tab in the Mouse control panel utility).
'If during those two seconds the process makes the first GUI call, the system gives five more seconds to the process. If during those five seconds the process shows a window, the system gives five more seconds to the process to finish drawing the window.
'The system turns the feedback cursor off after the first call to GetMessage, regardless of whether the process is drawing.
'0x00000080 Indicates that the feedback cursor is forced off while the process is starting. The Normal Select cursor is displayed.
'0x00002000 Indicates that any windows created by the process cannot be pinned on the taskbar.
'This flag must be combined with STARTF_TITLEISAPPID.
'0x00000020 Indicates that the process should be run in full-screen mode, rather than in windowed mode.
'This flag is only valid for console applications running on an x86 computer.
'0x00001000 The lpTitle member contains an AppUserModelID. This identifier controls how the taskbar and Start menu present the application, and enables it to be associated with the correct shortcuts and Jump Lists. Generally, applications will use the SetCurrentProcessExplicitAppUserModelID and GetCurrentProcessExplicitAppUserModelID functions instead of setting this flag. For more information, see Application User Model IDs.
'If STARTF_PREVENTPINNING is used, application windows cannot be pinned on the taskbar. The use of any AppUserModelID-related window properties by the application overrides this setting for that window only.
'This flag cannot be used with STARTF_TITLEISLINKNAME.
'0x00000800 The lpTitle member contains the path of the shortcut file (.lnk) that the user invoked to start this process. This is typically set by the shell when a .lnk file pointing to the launched application is invoked. Most applications will not need to set this value.
'This flag cannot be used with STARTF_TITLEISAPPID.
'0x00000008 The dwXCountChars and dwYCountChars members contain additional information.
'0x00000010 The dwFillAttribute member contains additional information.
'0x00000200 The hStdInput member contains additional information.
'This flag cannot be used with STARTF_USESTDHANDLES.
'0x00000004 The dwX and dwY members contain additional information.
'0x00000001 The wShowWindow member contains additional information.
'0x00000002 The dwXSize and dwYSize members contain additional information.
'0x00000100 The hStdInput, hStdOutput, and hStdError members contain additional information.
'If this flag is specified when calling one of the process creation functions, the handles must be inheritable and the function's bInheritHandles parameter must be set to TRUE. For more information, see Handle Inheritance.
'If this flag is specified when calling the GetStartupInfo function, these members are either the handle value specified during process creation or INVALID_HANDLE_VALUE.
'Handles must be closed with CloseHandle when they are no longer needed.
'This flag cannot be used with STARTF_USEHOTKEY.
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
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
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _
phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long) 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 ReadFile Lib "kernel32" (ByVal hFile As Long, _
ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Debug.Print ShellResult("cmd /c dir c:\")
Debug.Print ShellResult("ipconfig /all")
'可以执行通过shell执行的命令，并将结果以字符串方式返回。请注意，执行cmd内部命令时请用 “cmd /c dir c:\” 这样的形式。
Public Function ShellResult(ByVal CommandLine As String) As String
Dim Proc As PROCESS_INFORMATION '进程信息
Dim Start As STARTUPINFO '启动信息
Dim SecAttr As SECURITY_ATTRIBUTES '安全属性
Dim hReadPipe As Long '读取管道句柄
Dim hWritePipe As Long '写入管道句柄
Dim lngBytesRead As Long '读出数据的字节数
Dim strBuffer As String * 256 '读取管道的字符串buffer
Dim Command As String 'DOS命令
Dim ret As Long 'API函数返回值
Dim lpOutputs As String '读出的最终结果
.nLength = LenB(SecAttr)
.bInheritHandle = True
.lpSecurityDescriptor = 0
ret = CreatePipe(hReadPipe, hWritePipe, SecAttr, 0)
If ret = 0 Then
MsgBox "无法创建管道", vbExclamation, "错误"
.cb = LenB(Start)
.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
.hStdOutput = hWritePipe '设置输出管道
.hStdError = hWritePipe '设置错误管道
'Command = Getwinsys & "ipconfig.exe /all" 'DOS进程以ipconfig.exe为例
'Command = Getwinsys & "tracert www.google.com" 'DOS进程以ipconfig.exe为例
Command = Getwinsys & CommandLine
ret = CreateProcess(vbNullString, Command, SecAttr, SecAttr, True, _
NORMAL_PRIORITY_CLASS, ByVal 0, vbNullString, Start, Proc)
If ret = 0 Then
MsgBox "无法启动新进程", vbExclamation, "错误"
ret = CloseHandle(hWritePipe)
ret = ReadFile(hReadPipe, strBuffer, 256, lngBytesRead, ByVal 0)
'If Len(lpOutputs) > 0 Then
' Debug.Print Right(lpOutputs, 1), Asc(Right(lpOutputs, 1)), Right(lpOutputs, 7)
lpOutputs = lpOutputs & Left(strBuffer, lngBytesRead)
strBuffer = ""
Loop While (ret <> 0) '当ret=0时说明ReadFile执行失败，已经没有数据可读了
ret = CloseHandle(Proc.hProcess)
ret = CloseHandle(Proc.hThread)
ret = CloseHandle(hReadPipe)
'Debug.Print lpOutputs '输出结果
ShellResult = lpOutputs
'MsgBox lpOutputs, vbInformation, "结果"
Public Function Getwinsys() As String
Dim aa As String, jj As String
aa = Environ("ComSpec")
jj = InStrRev(aa, "\")
Getwinsys = Trim(Mid(aa, 1, jj))