VB好像不能传递NULL参数,说byref类型不符,改用该类型的空变量传递,编译后运行即告非法操作,被Windows关闭了strApp = "C:\3dsmax4\3dsmax.exe" strCmdLine = "-Q"Dim si As STARTUPINFO Dim pi As PROCESS_INFORMATION Dim at As SECURITY_ATTRIBUTES GetStartupInfo si CreateProcess strApp, strCmdLine, at, at, False, 0, Null, Null, si, pi WaitForInputIdle pi.hProcess, 20000 '//最多等20秒
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Long, lpThreadAttributes As Long, 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 Dim pi As PROCESS_INFORMATION Dim at As SECURITY_ATTRIBUTES GetStartupInfo si CreateProcess strApp, strCmdLine, 0&, 0&, False, 0, 0&, "", si, pi WaitForInputIdle pi.hProcess, 20000 '//最多等20秒还是非法操作
这个问题一直没有解决,但是CSDN要强制结贴,所以没有办法了
Option ExplicitConst INFINITE = &HFFFF Const STARTF_USESHOWWINDOW = &H1 Public Enum enSW SW_HIDE = 0 SW_NORMAL = 1 SW_MAXIMIZE = 3 SW_MINIMIZE = 6 End Enum 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 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 Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Public Enum enPriority_Class NORMAL_PRIORITY_CLASS = &H20 IDLE_PRIORITY_CLASS = &H40 HIGH_PRIORITY_CLASS = &H80 End Enum 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 WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPublic PLIPath As StringPublic Function SuperShell(ByVal App As String, ByVal WorkDir As String, ByVal Cmd As String) As Boolean Dim PClass As Long Dim sinfo As STARTUPINFO Dim pinfo As PROCESS_INFORMATION '必须 Dim sec1 As SECURITY_ATTRIBUTES Dim sec2 As SECURITY_ATTRIBUTES '设置结构数据 sec1.nLength = Len(sec1) sec2.nLength = Len(sec2) sinfo.cb = Len(sinfo) '设置参数及状态 sinfo.dwFlags = STARTF_USESHOWWINDOW sinfo.wShowWindow = SW_NORMAL '设置优先级 PClass = HIGH_PRIORITY_CLASS '启动 If CreateProcess(vbNullString, App & Cmd, sec1, sec2, False, PClass, 0&, WorkDir, sinfo, pinfo) Then '等待 WaitForSingleObject pinfo.hProcess, INFINITE SuperShell = True Else SuperShell = False End If End Function
dwMilliseconds Specifies the time-out interval, in milliseconds. The function returns if the interval elapses, even if the object state is nonsignaled. If dwMilliseconds is zero, the function tests the object state and returns immediately. If dwMilliseconds is INFINITE, the function time-out interval never elapses. 这是API - GUIDE上的, . If dwMilliseconds is zero, the function tests the object state and returns immediately 到是可以用用
这个办法并不是很好,等待时目标的关闭也不能正常的关闭。要强制关闭进程才可以。 我试过,总不满意。我贴出一贴来供大家参考:若谁有更高明的做法烦请也贴出来,我结帐。使Shell指令具Wait功能 VB 中,常以Shell指令来执行外部程式,然而它在Create该外部process 後,立刻 就会回到vb 的下一行程式,无法做到等待该Process结束时,才执行下一行指令, 或是说,无法得知该Process是否已结束,甚者,该Process执行到一半,又该如何 中止其执行等等,这些都不是Shell指令所能控制的,因此我们需使API的帮助来完 成。第一个问题,如何等待shell所Create的process结束後才往後执行vb的程式。 首先要知道的是,每个Process有唯一的一个ProcessID,这是OS给定的,用来 区别每个 Process,这个Process ID(PID)主要可用来取得该Process相对应的一些 资讯,然而要对该Process的控制,却大多透过 Process Handle(hProcess)。VB Shell指令的传回值是PID,而非hProcess,所以我们需透过OpenProcess这个API来 取得 hProcess而OpenProcess()的第一个参数,指的是所取得的hProcess所具有的 能力,像 PROCESS_QUERY_INFORMATION 便是让GetExitCode()可取得hProcess所指 的process之状态,而PROCESS_TERMINATE,便是让TerminateProcess(hProcess..) 的指令能够生效,也就是说,不同参数设定,使hProcess所具有的权限、能力有所 不同。取得 hProcess後便可以使用WaitForSingleObject()来等待hProcess状态的 改变,也就是说,它会等待 hProcess所指的process执行完,这个指令才结束,它 第二个参数所指的是 WaitForSingleObject()所要等待的时间(in milliseconds ) ,如果超过所指的时间,就TimeOut而结束WaitForSingleObject()的等待。若要它 无限的等下去,就设定为INFINITE。pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) ExitEvent = WaitForSingleObject(hProcess, INFINITE) Call CloseHandle(hProcess) 上例会无限等待shell指令create之process结束後,才再做後面的vb指令。有 时觉得那会等太久,所以有第二个解决方式:等process结束时再通知vb 就好,即 :设定一个公用变数(isDone),当它变成True时代表Shell所Create的Process已结 束。当Process还在执行时,GetExitCodeProcess会传&H103给其第二个参数,直到 结束时才传另外的数值,如果程式正常结束,那Exitcode = 0,否则就得看它如何 结束了。或许有人在其他地方看到 loop的地方是Loop while Exitcode <> 0,那 有一点危险,如果以这程子来看,您不是用F4来离开pe2而是用右上方 X 的结束 dos window那麽,会因为ExitCode的值永远不会是0,而进入无穷的回圈。Dim pid As Long pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) isDone = False Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Call CloseHandle(hProcess) isDone = True 另外,如果您的shell所Create的程式,有视窗且为立刻Focus者,可另外用以 下的方式Dim pid As Long Dim hwnd5 As Long pid = Shell("c:\tools\spe3\pe2.exe", vbNormalFocus) hwnd5 = GetForegroundWindow() isDone = False Do While IsWindow(hwnd5) DoEvents Loop isDone = True而如何强迫shell所Create的process结束呢,那便是 Dim aa As Long If hProcess <> 0 Then aa = TerminateProcess(hProcess, 3838) End IfhProcess便是先前的例子中所取得的那个Process Handle, 3838所指的是传给 GetExitCodeProcess()中的第二参数,这是我们任意给的,但最好不要是0,因为 0一般是代表正常结束,当然这样设也不会有错。当然不可设&H103,以这个例子来 看,如果程式正处於以下的LOOP Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Debug.print ExitCode 而执行了 TerminateProcess(hProcess, 3838)那会看到ExitCode = 3838。然 而,这个方式在win95没问题,在NT中,可能您要在OpenProcess()的第一个参数要 更改成 PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE 这样才能Work。不过 良心的建议,非到最後关头,不要使用TerminateProcess(),因不正常的结束,往 往许多程式结束前所要做的事都没有做,可能造成Resource的浪费,甚者,下次再 执行某些程式时会有问题,例如:本人常使用MS-dos Shell Link 的方式执行一程 式,透过Com port与大电脑的联结,如果Ms-dos Shell Link 不正常结束,下次再 想Link时,会发现too Many Opens,这便是一例。另外,有人使用Shell来执行.bat档,即: pid = Shell("c:\aa.bat", vbNormalFocus) 可是却遇上aa.bat结束了,但ms-dos的Window却仍活着,那可以用以下的方式来做 pid = Shell("c:\command.com /c c:\aa.bat", vbNormalFocus) 那是执行Command.com,而Command.com指定执行c:\aa.bat 而且结束时自动Close所有程式如下: Private Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" _ (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CloseHandle Lib "kernel32" _ (ByVal hObject As Long) As Long Private Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, lpExitCode As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" _ (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function IsWindow Lib "user32" _ (ByVal hwnd As Long) As LongConst PROCESS_QUERY_INFORMATION = &H400 Const STILL_ALIVE = &H103 Const INFINITE = &HFFFFPrivate ExitCode As Long Private hProcess As Long Private isDone As Long Private Sub Command1_Click() Dim pid As Long pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) isDone = False Do Call GetExitCodeProcess(hProcess, ExitCode) Debug.Print ExitCode DoEvents Loop While ExitCode = STILL_ALIVE Call CloseHandle(hProcess) isDone = True End SubPrivate Sub Command2_Click() Dim pid As Long Dim ExitEvent As Long pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus) hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) ExitEvent = WaitForSingleObject(hProcess, INFINITE) Call CloseHandle(hProcess) End SubPrivate Sub Command3_Click() Dim aa As Long If hProcess <> 0 Then aa = TerminateProcess(hProcess, 3838) End IfEnd SubPrivate Sub Command4_Click() Dim pid As Long Dim hwnd5 As Long pid = Shell("c:\tools\spe3\pe2.exe", vbNormalFocus) hwnd5 = GetForegroundWindow() isDone = False Do While IsWindow(hwnd5) DoEvents Loop isDone = True End SubPrivate Sub Command5_Click() Dim pid As Long 'pid = Shell("c:\windows\command\xcopy c:\aa.bat a:", vbHide) pid = Shell("c:\command.com /c c:\aa.bat", vbNormalFocus) End Sub
pid = Shell(strAppCmd, vbNormalFocus)
mWnd = OpenProcess(SYNCHRONIZE, 0, pid)
WaitForSingleObject mWnd, 20000
或者改用更大的时间,但每次都是超时,具体应该怎么用?
PROCESS_INFORMATION pi;
GetStartupInfo(&si);
CreateProcess("C:\\winnt\\notepad.EXE",NULL,NULL,NULL,FALSE,0,NULL,NULL,&si,&pi);
WaitForInputIdle (pi.hProcess ,2000); //最多等2秒
strCmdLine = "-Q"Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim at As SECURITY_ATTRIBUTES
GetStartupInfo si
CreateProcess strApp, strCmdLine, at, at, False, 0, Null, Null, si, pi
WaitForInputIdle pi.hProcess, 20000 '//最多等20秒
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim at As SECURITY_ATTRIBUTES
GetStartupInfo si
CreateProcess strApp, strCmdLine, 0&, 0&, False, 0, 0&, "", si, pi
WaitForInputIdle pi.hProcess, 20000 '//最多等20秒还是非法操作
Const STARTF_USESHOWWINDOW = &H1
Public Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
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
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
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
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 WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPublic PLIPath As StringPublic Function SuperShell(ByVal App As String, ByVal WorkDir As String, ByVal Cmd As String) As Boolean
Dim PClass As Long
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
'必须
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
'设置结构数据
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
sinfo.cb = Len(sinfo)
'设置参数及状态
sinfo.dwFlags = STARTF_USESHOWWINDOW
sinfo.wShowWindow = SW_NORMAL
'设置优先级
PClass = HIGH_PRIORITY_CLASS
'启动
If CreateProcess(vbNullString, App & Cmd, sec1, sec2, False, PClass, 0&, WorkDir, sinfo, pinfo) Then
'等待
WaitForSingleObject pinfo.hProcess, INFINITE
SuperShell = True
Else
SuperShell = False
End If
End Function
如果是读取完毕恐怕没有办法。。
Specifies the time-out interval, in milliseconds. The function returns if the interval elapses, even if the object state is nonsignaled. If dwMilliseconds is zero, the function tests the object state and returns immediately. If dwMilliseconds is INFINITE, the function time-out interval never elapses.
这是API - GUIDE上的, . If dwMilliseconds is zero, the function tests the object state and returns immediately 到是可以用用
我试过,总不满意。我贴出一贴来供大家参考:若谁有更高明的做法烦请也贴出来,我结帐。使Shell指令具Wait功能
VB 中,常以Shell指令来执行外部程式,然而它在Create该外部process 後,立刻
就会回到vb 的下一行程式,无法做到等待该Process结束时,才执行下一行指令,
或是说,无法得知该Process是否已结束,甚者,该Process执行到一半,又该如何
中止其执行等等,这些都不是Shell指令所能控制的,因此我们需使API的帮助来完
成。第一个问题,如何等待shell所Create的process结束後才往後执行vb的程式。
首先要知道的是,每个Process有唯一的一个ProcessID,这是OS给定的,用来
区别每个 Process,这个Process ID(PID)主要可用来取得该Process相对应的一些
资讯,然而要对该Process的控制,却大多透过 Process Handle(hProcess)。VB
Shell指令的传回值是PID,而非hProcess,所以我们需透过OpenProcess这个API来
取得 hProcess而OpenProcess()的第一个参数,指的是所取得的hProcess所具有的
能力,像 PROCESS_QUERY_INFORMATION 便是让GetExitCode()可取得hProcess所指
的process之状态,而PROCESS_TERMINATE,便是让TerminateProcess(hProcess..)
的指令能够生效,也就是说,不同参数设定,使hProcess所具有的权限、能力有所
不同。取得 hProcess後便可以使用WaitForSingleObject()来等待hProcess状态的
改变,也就是说,它会等待 hProcess所指的process执行完,这个指令才结束,它
第二个参数所指的是 WaitForSingleObject()所要等待的时间(in milliseconds )
,如果超过所指的时间,就TimeOut而结束WaitForSingleObject()的等待。若要它
无限的等下去,就设定为INFINITE。pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
ExitEvent = WaitForSingleObject(hProcess, INFINITE)
Call CloseHandle(hProcess) 上例会无限等待shell指令create之process结束後,才再做後面的vb指令。有
时觉得那会等太久,所以有第二个解决方式:等process结束时再通知vb 就好,即
:设定一个公用变数(isDone),当它变成True时代表Shell所Create的Process已结
束。当Process还在执行时,GetExitCodeProcess会传&H103给其第二个参数,直到
结束时才传另外的数值,如果程式正常结束,那Exitcode = 0,否则就得看它如何
结束了。或许有人在其他地方看到 loop的地方是Loop while Exitcode <> 0,那
有一点危险,如果以这程子来看,您不是用F4来离开pe2而是用右上方 X 的结束
dos window那麽,会因为ExitCode的值永远不会是0,而进入无穷的回圈。Dim pid As Long
pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
isDone = False
Do
Call GetExitCodeProcess(hProcess, ExitCode)
Debug.Print ExitCode
DoEvents
Loop While ExitCode = STILL_ALIVE
Call CloseHandle(hProcess)
isDone = True 另外,如果您的shell所Create的程式,有视窗且为立刻Focus者,可另外用以
下的方式Dim pid As Long
Dim hwnd5 As Long
pid = Shell("c:\tools\spe3\pe2.exe", vbNormalFocus)
hwnd5 = GetForegroundWindow()
isDone = False
Do While IsWindow(hwnd5)
DoEvents
Loop
isDone = True而如何强迫shell所Create的process结束呢,那便是
Dim aa As Long
If hProcess <> 0 Then
aa = TerminateProcess(hProcess, 3838)
End IfhProcess便是先前的例子中所取得的那个Process Handle, 3838所指的是传给
GetExitCodeProcess()中的第二参数,这是我们任意给的,但最好不要是0,因为
0一般是代表正常结束,当然这样设也不会有错。当然不可设&H103,以这个例子来
看,如果程式正处於以下的LOOP
Do
Call GetExitCodeProcess(hProcess, ExitCode)
Debug.Print ExitCode
DoEvents
Loop While ExitCode = STILL_ALIVE
Debug.print ExitCode 而执行了 TerminateProcess(hProcess, 3838)那会看到ExitCode = 3838。然
而,这个方式在win95没问题,在NT中,可能您要在OpenProcess()的第一个参数要
更改成 PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE 这样才能Work。不过
良心的建议,非到最後关头,不要使用TerminateProcess(),因不正常的结束,往
往许多程式结束前所要做的事都没有做,可能造成Resource的浪费,甚者,下次再
执行某些程式时会有问题,例如:本人常使用MS-dos Shell Link 的方式执行一程
式,透过Com port与大电脑的联结,如果Ms-dos Shell Link 不正常结束,下次再
想Link时,会发现too Many Opens,这便是一例。另外,有人使用Shell来执行.bat档,即:
pid = Shell("c:\aa.bat", vbNormalFocus)
可是却遇上aa.bat结束了,但ms-dos的Window却仍活着,那可以用以下的方式来做
pid = Shell("c:\command.com /c c:\aa.bat", vbNormalFocus)
那是执行Command.com,而Command.com指定执行c:\aa.bat 而且结束时自动Close所有程式如下:
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As LongConst PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103
Const INFINITE = &HFFFFPrivate ExitCode As Long
Private hProcess As Long
Private isDone As Long
Private Sub Command1_Click()
Dim pid As Long
pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
isDone = False
Do
Call GetExitCodeProcess(hProcess, ExitCode)
Debug.Print ExitCode
DoEvents
Loop While ExitCode = STILL_ALIVE
Call CloseHandle(hProcess)
isDone = True
End SubPrivate Sub Command2_Click()
Dim pid As Long
Dim ExitEvent As Long
pid = Shell("C:\tools\spe3\pe2.exe", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
ExitEvent = WaitForSingleObject(hProcess, INFINITE)
Call CloseHandle(hProcess)
End SubPrivate Sub Command3_Click()
Dim aa As Long
If hProcess <> 0 Then
aa = TerminateProcess(hProcess, 3838)
End IfEnd SubPrivate Sub Command4_Click()
Dim pid As Long
Dim hwnd5 As Long
pid = Shell("c:\tools\spe3\pe2.exe", vbNormalFocus)
hwnd5 = GetForegroundWindow()
isDone = False
Do While IsWindow(hwnd5)
DoEvents
Loop
isDone = True
End SubPrivate Sub Command5_Click()
Dim pid As Long
'pid = Shell("c:\windows\command\xcopy c:\aa.bat a:", vbHide)
pid = Shell("c:\command.com /c c:\aa.bat", vbNormalFocus)
End Sub