难。谁知道怎么同步方式执行SHELL吗？

[nplgcsdn]

注意 缺省情况下，Shell 函数是以异步方式来执行其它程序的。也就是说，用 Shell 启动的程序可能还没有完成执行过程，就已经执行到 Shell 函数之后的语句。
我要的是以同步方式执行SHELL，等SHELL执行完本身的命令后再执行后面的命令。

[thirdapple]

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Function StillRun(ByVal ProgramID) As Boolean
Dim lHProgram As Long
Dim lReturn As Long
Dim hProgram As Long
hProgram = 0
hProgram = OpenProcess(0, False, ProgramID)
If Not hProgram = 0 Then
StillRun = True
Else
StillRun = False
End If
CloseHandle hProgram
End Function
--------------------------------------------------------------------
使用：
pID = Shell(调用的程序)
While StillRun(pID)
' DoEvents
Wend

[thirdapple]

To superdullwolf
尝试在启动毒霸的时候传一个参数，不模拟按键。

[超级大笨狼]

我想到用VB做个屏幕保护程序，自动运行杀毒软件，可是用sendkeys触发按钮的时候，屏保就自动关闭了,sendmassage可以代替按键吗？会不会触发键盘鼠标事件？我想触发按钮但不中断屏保程序啊，就是运行金山杀毒并且按一下回车开始杀毒

[dreamtou]

Public Function RunShell(cmdline As String) As Boolean
Dim hProcess As Long
Dim ProcessID As Long
Dim ExitCodeLong As Long
Dim str1 As String
ProcessID = Shell(cmdline, vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
Do
Call GetExitCodeProcess(hProcess, ExitCodeLong)
DoEvents
'If ExitCode Then Exit Do
Loop While ExitCodeLong = STATUS_PENDING
Call CloseHandle(hProcess)
RunShell = True
End Function

[nplgcsdn]

这个是用程序的方式解决这个问题。我想知道WINDOWS本身有没有什么办法同步方式在程序中使用。比如一个什么命令之类的。

[用户 昵称]

use shellexecute or createprocess APIs

[suntt]

WaitForSingleObject

[of123]

1
利用是利用Win32 API的FindWindow函数。该函数可以搜索指定标题或类的窗口，你可以在调用第一个可执行文件后用FindWindow函数去找指定的窗口，如果找到了，就说明第一个文件还未运行完，等待，直到用FindWindow函数找不到指定窗口，就可执行后续语句。

2
利用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

3
利用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命令。

[fuxc]

针对 of123()的回答：
方法1：FindWindow要依赖于程序标题，但标题往往不确定或重复。
方法2：win2k下为何不成功？
方法3：运行良好，可惜shell期间，主程序无响应，容易引起客户困惑。

还有一种方法，不用API：
'引用 Windows Script Host Object Model
Private Sub Command1_Click()
Dim x As New IWshRuntimeLibrary.IWshShell_Class
Me.Enabled = False
x.Run x.ExpandEnvironmentStrings("%WinDir%") & "\notepad.exe", , True
VBA.MsgBox "执行完毕"
x.Run "CALC.EXE", , True
VBA.MsgBox "执行完毕"
Me.Enabled = True
End Sub

[fuxc]

不过也有缺点：
win2k下有些电脑不成功，
因为wshom.ocx接口有问题，但win2k的系统文件保护机制不允许替换这个文件~~

[fuxc]

方法2试验成功：

hProgram = OpenProcess(0, False, ProgramID)
替换为：
hProgram = OpenProcess(&H1F0FFF, False, ProgramID)

[用户 昵称]

Option Explicit

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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Private Declare Function dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function dcCreateProcess Lib "kernel32" Alias "CreateProcessA" (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 Declare Function dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long

Private Declare Function dcGetExitCodeProcess Lib "kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function dcTerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Const WAIT_TIMEOUT As Long = &H102

Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
Dim enAllFail As Long

On Error GoTo errExit

' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ret = dcCreateProcess(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

' Wait for the shelled application to finish:
ret = dcWaitForSingleObject(proc.hProcess, INFINITE)
If ret = WAIT_TIMEOUT Then
'After 15 min program may be hung?
Call dcTerminateProcess(proc.hProcess, enAllFail)
End If
Call dcGetExitCodeProcess(proc.hProcess, ret&)
Call dcCloseHandle(proc.hProcess)
ExecCmd = ret&
Exit Function
errExit:
'Error handler here

End Function

[czjw]

xuexi!

[hhjjhjhj]

如下处理不行吗？
x=Shell("XXXXXXXXX")
Do while x=0
Doevents
loop

[qbilbo]

最简单的方法：

Private Sub Command1_Click()
Dim mShell As Object

Set mShell = CreateObject("wscript.shell")
mShell.Run "c:\windows\calc.exe", 8, True

MsgBox "ok"

End Sub

[suntt]

re: JennyVenus()
WaitForSingleObject的第二的参数是不能用INFINITE，否则他会一直等待下去，一直等到
proc.hProcess close为止，我认为应当为他设置一个值，然后判断
If ret = WAIT_TIMEOUT then