关于SHELL函数的使用?在线等待！高分相赠！
关于SHELL函数的使用：
我在A程序中使用SHELL函数调用B程序（数据处理）的时候，B程序执行的时候，A程序继续向下执行。怎样实现B程序执行时，A程序等待。B程序执行结束后，A程序继续执行。
在线等待！高分相赠！
问题点数：0、回复次数：13Top
1 楼zhangcyu（）回复于 2003-11-04 15:53:10 得分 0
vb 不能实现多线程程序，只能用VCTop
2 楼xiaoyvr（绿草）回复于 2003-11-04 15:55:48 得分 0
用API WaitForSingleObjectTop
3 楼hwxnhk0326（殺殺人，灌灌水）回复于 2003-11-04 16:14:33 得分 0
xiaoyvr(绿草)兄: 能够详细点吗?我以前也碰见过这样一来的问题
比如:
If Data1.Recordset.RecordCount > 5 Then
a = a + 1
End If
当 Data1 控件所连接的表的记录很多的时候 a 的值根本就不会变化.
因为他累计表的记录数目要好长一段时间然后再判断 Data1.Recordset.RecordCount > 5
设定断点来看 Data1.Recordset.RecordCount (?Data1.Recordset.RecordCount )
的时候 Data1.Recordset.RecordCount =1
..............
再看一次他又变了(可能是235)
再看一次他又变了(>235)
Top
4 楼demo001（给分是我最大的快乐）回复于 2003-11-04 16:22:07 得分 0
http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=78069Top
5 楼berylw（漏洞）回复于 2003-11-04 16:29:36 得分 0
试一下在SHELL下面加一条DoEvents，看看行不行Top
6 楼cuizm（射天狼 http://www.j2soft.cn/）回复于 2003-11-04 16:36:45 得分 0
Option Explicit
Const INFINITE As Long = -1&
Const STATUS_WAIT_0 As Long = &H0
Const WAIT_OBJECT_0 As Long = STATUS_WAIT_0
Const NORMAL_PRIORITY_CLASS As Long = &H20&
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 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
End Type
Private Declare Function WaitForSingleObject Lib "Kernel32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function InputIdle Lib "user32" Alias "WaitForInputIdle" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "Kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Sub Command1_Click()
SyncShell "D:\ProgramsExample\DelphiExample\stk\Stk.exe"
End Sub
Public Function StartProcess(CommandLine As String, Optional Hide As Boolean = False) As Long
Const STARTF_USESHOWWINDOW As Long = &H1
Const SW_HIDE As Long = 0
Dim proc As PROCESS_INFORMATION
Dim Start As STARTUPINFO
'Initialize the STARTUPINFO structure:
Start.cb = Len(Start)
If Hide Then
Start.dwFlags = STARTF_USESHOWWINDOW
Start.wShowWindow = SW_HIDE
End If
'Start the shelled application:
CreateProcessA 0&, CommandLine, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, Start, proc
StartProcess = proc.hProcess
End Function
Public Function SyncShell(CommandLine As String, Optional Timeout As Long, _
Optional WaitForInputIdle As Boolean, Optional Hide As Boolean = False) As Boolean
Dim hProcess As Long
Const STARTF_USESHOWWINDOW As Long = &H1
Const SW_HIDE As Long = 0
Dim ret As Long
Dim nMilliseconds As Long
If Timeout > 0 Then
nMilliseconds = Timeout
Else
nMilliseconds = INFINITE
End If
hProcess = StartProcess(CommandLine, Hide)
If WaitForInputIdle Then
'Wait for the shelled application to finish setting up its UI:
ret = InputIdle(hProcess, nMilliseconds)
Else
'Wait for the shelled application to terminate:
ret = WaitForSingleObject(hProcess, nMilliseconds)
End If
CloseHandle hProcess
'Return True if the application finished. Otherwise it timed out or erred.
SyncShell = (ret = WAIT_OBJECT_0)
End Function
Top
7 楼TBNTB（無人的夜里孤軍奮斗!）回复于 2003-11-04 17:55:07 得分 0
UPTop
8 楼demo001（给分是我最大的快乐）回复于 2003-11-04 18:07:30 得分 0
另外强烈推荐你看这篇文章
http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=85141Top
9 楼since1990（level）回复于 2003-11-04 18:07:38 得分 0
upTop
10 楼hxy2003（asfd）回复于 2003-11-04 18:13:16 得分 0
upTop
11 楼FSoft（）回复于 2003-11-04 18:38:13 得分 0
在Shell函数的后面加一个Do循环来判断B是否运行完成,判断条件可以用B程序的标题,B程序的标题可以用API函数(FindWindow)来获得.如下:
Dim Lngnums as long
Shell(B程序)
Lngnums=FindWindow(vbNullString,B程序标题)
Do
loop While Lngnums=0Top
12 楼kmzs（.:RNPA:.山水岿濛）回复于 2003-11-04 19:07:11 得分 0
用creatprogressTop
13 楼rainstormmaster（暴风雨 v2.0）回复于 2003-11-04 19:15:06 得分 0
使Shell指令具Wait功能
11/16/2001 16:49:12·天极网
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 If
hProcess便是先前的例子中所取得的那个Process Handle， 3838所指的是传给GetExitCodeProcess()中的第二参数，这是我们任意给的，但最好不要是0，因为0一般是代表正常结束，当然这样设也不会有错。当然不可设&H103，以这个例子来看，如果程式正处於以下的LOOPDo
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 Long
Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103
Const INFINITE = &HFFFF
Private 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 Sub
Private 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 Sub
Private Sub Command3_Click()
Dim aa As Long
If hProcess <> 0 Then
aa = TerminateProcess(hProcess, 3838)
End If
End Sub
Private 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 Sub
Private 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 SubTop
