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

Question

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

Answer 1

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 LongFunction 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

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

use shellexecute or createprocess APIs

Answer 7

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命令。

Answer 8

针对 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

Answer 9

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

Answer 10

方法2试验成功：hProgram = OpenProcess(0, False, ProgramID)
替换为：
hProgram = OpenProcess(&H1F0FFF, False, ProgramID)

Answer 11

Option ExplicitPrivate 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 TypePrivate Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessID As Long
  dwThreadID As Long
End TypePrivate Declare Function dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate 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 LongPrivate Declare Function dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As LongPrivate 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 LongPrivate Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Const WAIT_TIMEOUT As Long = &H102Public 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

Answer 12

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

Answer 13

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

Answer 14

最简单的方法：Private Sub Command1_Click()
Dim mShell As ObjectSet mShell = CreateObject("wscript.shell")
mShell.Run "c:\windows\calc.exe", 8, TrueMsgBox "ok"End Sub