在模块里作如下声明,调用ExecCmd函数搞定。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 LongPrivate Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
   Dim proc As PROCESS_INFORMATION
   Dim start As STARTUPINFO
   Dim ret 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

解决方案 »

  1.   

    我试用了一下,运行时提示WAIT_TIMEOUT没有定义,dcTerminateProcess没有声明。
    请你再帮着修改一下。
    另外,想问一下,dcWaitForSingleObject、dcCreateProcess等这些函数,我在哪里可以查到它们的用法?
      

  2.   

    see thisOption 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
      

  3.   

    '一直等待,直至外部应用程序终止运行
    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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Const INFINITE = -1&
    Const SYNCHRONIZE = &H100000Dim iTask As Long, ret As Long, pHandle As Long
    iTask = Shell("C:\外部应用程序.EXE", 0)
    pHandle = OpenProcess(SYNCHRONIZE, False, iTask)
    ret = WaitForSingleObject(pHandle, INFINITE)
    ret = CloseHandle(pHandle)