VB 执行其他程序并等待其结束
近期在编写程序过程中用Winrar中的DOS程序rar.exe 对.Rar文件进行处理，并将结果写入一个文件，后面的程序将此文件用RichTextFile控件LoadFile方法装入,并显示出来，程序步进调试时，均一切正常，生成可执行文件后运行时，却总是出问题，RichTextFile控件中显示的不是此前Rar.exe运行的结果，而命令按钮重复一下，则显示正常。百思不得其解，后来上网找，总算明白了症结在Loadfile方法执行时，上述结果文件Winrar还没有运行完毕而准备好。走了不少弯路，故记之。
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF '所有存取方式，另外还有两个常数也经常用到：
Private Const PROCESS_TERMINATE = &H1 '取得进程的关闭权限
Private Const PROCESS_QUERY_INFORMATION = &H400 '取得进程的查询权限
OpenProcess(PROCESS_TERMINATE, 0, pid) '要关闭进程的话用这个
OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid) '要查询进程信息的话用这个
OpenProcess(PROCESS_ALL_ACCESS, 0, pid) '获得进程操作的所有权限
等待函数可使线程自愿进入等待状态，直到一个特定的内核对象变为已通知状态为止。这些等待函数中最常用的是 WaitForSingleObject:
DWORD WaitForSingleObject(HANDLE hObject, DWORD dwMilliseconds);
当线程调用该函数时，第一个参数 hObject 标识一个能够支持被通知/未通知的内核对象。
第二个参数 dwMilliseconds.允许该线程指明，为了等待该对象变为已通知状态，它将等待多长时间。调用下面这个函数将告诉系统，调用函数准备等待到 hProcess 句柄标识的进程终止运行为止：
WaitForSingleObject(hProcess, INFINITE);
第二个参数告诉系统，调用线程愿意永远等待下去（无限时间量），直到该进程终止运行。
通常情况下， INFINITE 是作为第二个参数传递给 WaitForSingleObject 的，不过也可以传递任何一个值（以毫秒计算）。
顺便说一下， INFINITE 已经定义为0xFFFFFFFF（或-1）(VB中&HFFFFFFFF)。当然，传递 INFINITE 有些危险。如果对象永远不变为已通知状态，那么调用线程永远不会被唤醒，它将永远处于死锁状态， 不过，它不会浪费宝贵的 CPU 时间。
下面是如何用一个超时值而不是 INFINITE 来调用 WaitForSingleObject 的例子：
DWORD dw = WaitForSingleObject(hProcess, 5000);
如何在vb中用同步方式调用外部dos命令
shell()函数似乎缺省为异步方式，如何改为同步呢？ 还有没有其他办法呢？
（所谓同步方式，就是说等执行完shell(...)语句对应的dos命令后，才开始执行下一语句。）
这是一个特别常见的问题，相信很多人都会遇到。
如果使用VB.Net，Shell函数增加了一个参数表示是否等待。例子：
Dim sysPath as String
SysPath = System.Environment.GetFolderPath(Environment.SpecialFolder.System)
Shell(sysPath & "\notepad.exe", AppWinStyle.NormalFocus, True)
但如果使用VB 5.0/6.0，就比较麻烦了，一般实现这种等待的方法有四种:
一：利用是利用Win32 API的FindWindow函数。
该函数可以搜索指定标题或类的窗口，你可以在调用第一个可执行文件后用FindWindow函数去找指定的窗口，如果找到了，就说明第一个文件还未运行完，等待，直到用FindWindow函数找不到指定窗口，就可以调用第二个文件。
这种方法简单，但有个毛病，就是如果满足条件的窗口不只一个，比如用户打开了两个有相同类或标题的窗口(一个是VB程序打开的，而另一个可能是用户自行打开的)，那么除非用户关闭这两个窗口，否则VB程序不会继续运行。比如Wise Install生成的安装程序就有这个毛病，它在安装过程中可能会用NotePad打开ReadMe文件，等用户看完ReadMe文件关闭窗口后继续安装，但如果用户此时用NotePad打开了其他文件，安装程序就会继续等待，应为FindWindow函数找到了NotePad窗口，可实际上这个窗口跟安装程序毫无关系。
二：利用Windows 95新增加的命令Start。这个命令可以调用Windows程序，通常用在批文件中。
它有一个/w开关，在被调用的程序继续运行结束之前等待。比如，你要调用的三个可执行文件为Command1、Command2和Command3，你可以构造一个批文件如下:
Start/w Command1
Start/w Command2
Start/w Command3
这个方法可以保证三个按既定顺序运行，但VB程序不能知道什么时候该批文件执行完毕。
三：利用Windows API的OpenProcess和CloseHandle函数来实现对被调用软件的检测：
1) 在VB中新建一个标准EXE工程；
2) 在Form1中声明OpenProcess和CloseHandle这两个Windows API函数；
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long,ByVal bInheritHandle As Long,ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
3) 然后编写下面的函数:
Function IsRunning(ByVal ProgramID) As Boolean ' 传入进程标识ID
Dim hProgram As Long '被检测的程序进程句柄
hProgram = OpenProcess(0, False, ProgramID)
If Not hProgram = 0 Then
IsRunning = True
Else
IsRunning = False
End If
CloseHandle hProgram
End Function
4) 在Form_Click()中加入代码：
Sub Form_Click()
Dim X
Me.Caption = "开始运行"
X = Shell("NotePad.EXE", 1)
While IsRunning(X)
DoEvents
Wend
Me.Caption = "结束运行"
End Sub
------------------我自写的一种方式----（已测试）------------
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Dim lngPId As Long
Dim lngPHandle As Long
lngPId = Shell(“CMD /C ........", vbNormalFocus)
lngPHandle = OpenProcess(&H1F0FFF, 0, lngPId) '所有存取方式
If lngPHandle <> 0 Then
Call WaitForSingleObject(lngPHandle, 8000) ' 最多等待8000毫秒， 或者程序已结束
Call CloseHandle(lngPHandle)
End If
--------------------------------------------------------------------
四：利用Win32 API的CreateProcess函数和WaitForSingleObject函数来进行这一工作。它的原理比较复杂，在此只介绍如何使用。首先建立一个模块(module)，然后输入以下语句：
Option Explicit
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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Global Const NORMAL_PRIORITY_CLASS = &H20&
Global Const INFINITE = -1&
Declare Function CloseHandle Lib "kernel32" (hObject As Long) As Boolean
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
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
Public Sub ShellAndWait(cmdline$)
Dim NameOfProc As PROCESS_INFORMATION
Dim NameStart As STARTUPINFO
Dim X As Long
NameStart.cb = Len(NameStart)
X = CreateProcessA(0&,cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, NameStart, NameOfProc)
X = WaitForSingleObject(NameOfProc.hProcess, INFINITE)
X = CloseHandle(NameOfProc.hProcess)
End Sub
建立一个窗体，并放一个命令按钮(Command1)在其上。在Command1_Click事件中输入以下内容：
Private Sub Command1_Click()
Dim AppToLaunch As String
AppToLaunch = "c:\win95\notepad.exe"
ShellAndWait AppToLaunch
End Sub
运行该程序，按下Command1，就会调用NotePad，在NotePad运行完毕之前，VB程序不会继续执行。你可以在程序中使用ShellAndWait来代替Shell命令。
2035
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
