ShellExecute 函数是通过资源管理器来启动程序, 而资源管理器启动程序之后,
并没有将 Process ID 或 Process Handle 传回来。所以比较难。

解决方案 »

  1.   

    我有一个例子!可以给你参考一下的!
    下面是Form 的内容
    VERSION 5.00
    Begin VB.Form frmShell32
       BorderStyle     =   3  'Fixed Dialog
       Caption         =   "Shell32 Demo"
       ClientHeight    =   3210
       ClientLeft      =   1095
       ClientTop       =   1515
       ClientWidth     =   6465
       Icon            =   "Shell32.frx":0000
       LinkTopic       =   "Form1"
       MaxButton       =   0   'False
       MinButton       =   0   'False
       PaletteMode     =   1  'UseZOrder
       ScaleHeight     =   3210
       ScaleWidth      =   6465
       ShowInTaskbar   =   0   'False
       Begin VB.TextBox Text2
          Height          =   285
          Left            =   180
          TabIndex        =   10
          Text            =   "Text2"
          Top             =   1890
          Width           =   1185
       End
       Begin VB.CommandButton Command1
          Cancel          =   -1  'True
          Caption         =   "E&xit"
          Height          =   375
          Index           =   1
          Left            =   1530
          TabIndex        =   8
          Top             =   2610
          Width           =   1185
       End
       Begin VB.CommandButton Command1
          Caption         =   "&Shell"
          Default         =   -1  'True
          Height          =   375
          Index           =   0
          Left            =   180
          TabIndex        =   7
          Top             =   2610
          Width           =   1185
       End
       Begin VB.Frame Frame1
          Caption         =   " Routine "
          Height          =   2805
          Left            =   3690
          TabIndex        =   4
          Top             =   180
          Width           =   2445
          Begin VB.OptionButton Option1
             Caption         =   "h&WndShell"
             Height          =   285
             Index           =   3
             Left            =   180
             TabIndex        =   12
             Top             =   1440
             Width           =   1995
          End
          Begin VB.OptionButton Option1
             Caption         =   "ShellAnd&Close"
             Height          =   285
             Index           =   2
             Left            =   180
             TabIndex        =   11
             Top             =   1080
             Width           =   1995
          End
          Begin VB.OptionButton Option1
             Caption         =   "ShellAnd&Loop"
             Height          =   285
             Index           =   1
             Left            =   180
             TabIndex        =   6
             Top             =   720
             Width           =   1995
          End
          Begin VB.OptionButton Option1
             Caption         =   "ShellAnd&Wait"
             Height          =   285
             Index           =   0
             Left            =   180
             TabIndex        =   5
             Top             =   360
             Width           =   1995
          End
       End
       Begin VB.TextBox Text1
          Height          =   285
          Left            =   180
          TabIndex        =   1
          Text            =   "Text1"
          Top             =   450
          Width           =   3255
       End
       Begin VB.ComboBox Combo1
          Height          =   315
          Left            =   180
          TabIndex        =   3
          Text            =   "Combo1"
          Top             =   1170
          Width           =   3255
       End
       Begin VB.Label Label3
          AutoSize        =   -1  'True
          Caption         =   "&Timeout (secs):"
          Height          =   195
          Left            =   180
          TabIndex        =   9
          Top             =   1620
          Width           =   1080
       End
       Begin VB.Label Label2
          AutoSize        =   -1  'True
          Caption         =   "Start &Mode:"
          Height          =   195
          Left            =   180
          TabIndex        =   2
          Top             =   900
          Width           =   825
       End
       Begin VB.Label Label1
          AutoSize        =   -1  'True
          Caption         =   "&Application:"
          Height          =   195
          Left            =   180
          TabIndex        =   0
          Top             =   180
          Width           =   825
       End
    End
    Attribute VB_Name = "frmShell32"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    ' ****************************************************************
    ' Shell32.Frm, Copyright ?996-97 Karl E. Peterson
    ' ****************************************************************
    ' You are free to use this code within your own applications, but you
    ' are expressly forbidden from selling or otherwise distributing this
    ' source code without prior written consent.
    ' ****************************************************************
    ' Demonstrates three methods to "Shell and Wait" under Win32.
    ' One deals with the infamous "Finished" behavior of Win95.
    ' Requires: Shell32.Bas
    ' ****************************************************************
    Option ExplicitPrivate Const bSpawn = 0
    Private Const bExit = 1
    Private Const oShellAndWait = 0
    Private Const oShellAndLoop = 1
    Private Const oShellAndClose = 2
    Private Const ohWndShell = 3Private Sub Command1_Click(Index As Integer)
       Dim TimeOut As Long
       Dim msg As String
       Dim nRet As Long   msg = "Job has just finished."
       Select Case Index
          Case bSpawn
             Select Case CLng(Frame1.Tag)
                Case oShellAndWait
                   TimeOut = Val(Text2.Text) * 1000
                   If TimeOut = 0 Then TimeOut = INFINITE
                   ShellAndWait Text1.Text, Combo1.ItemData(Combo1.ListIndex), TimeOut
                Case oShellAndLoop
                   ShellAndLoop Text1.Text, Combo1.ItemData(Combo1.ListIndex)
                Case oShellAndClose
                   ShellAndClose Text1.Text, Combo1.ItemData(Combo1.ListIndex)
                Case ohWndShell
                   nRet = hWndShell(Text1.Text, Combo1.ItemData(Combo1.ListIndex))
                   msg = Text1.Text & " has been started." & vbCrLf & _
                         "Main window handle: " & Hex(nRet)
             End Select
             MsgBox msg
          Case bExit
             Unload Me
       End Select
    End SubPrivate Sub Form_Load()
       Text1.Text = "Notepad"
       Text1.SelLength = Len(Text1.Text)
       Text2.Text = "10"
       Option1(0).Value = True
       UseVbStartMode Combo1
       Set Me.Icon = Nothing
    End SubPrivate Sub Option1_Click(Index As Integer)
       Select Case Index
          Case oShellAndWait
             Text2.Visible = True
             Label3.Visible = True
          Case oShellAndLoop, oShellAndClose, ohWndShell
             Text2.Visible = False
             Label3.Visible = False
       End Select
       Frame1.Tag = Index
    End SubPrivate Sub UseApiStartMode(Combo As ComboBox)
       Dim i As Integer
       Combo.Clear
       Combo.AddItem "(0) SW_HIDE"
       Combo.AddItem "(1) SW_SHOWNORMAL"
       Combo.AddItem "(2) SW_SHOWMINIMIZED"
       Combo.AddItem "(3) SW_SHOWMAXIMIZED"
       Combo.AddItem "(4) SW_SHOWNOACTIVATE"
       Combo.AddItem "(5) SW_SHOW"
       Combo.AddItem "(6) SW_MINIMIZE"
       Combo.AddItem "(7) SW_SHOWMINNOACTIVE"
       Combo.AddItem "(8) SW_SHOWNA"
       Combo.AddItem "(9) SW_RESTORE"
       For i = SW_HIDE To SW_RESTORE
          Combo.ItemData(i) = i
       Next i
       Combo.ListIndex = 1
    End SubPrivate Sub UseVbStartMode(Combo As ComboBox)
       Combo.Clear
       Combo.AddItem Format(vbHide, "(0)") & " vbHide"
       Combo.ItemData(Combo.NewIndex) = vbHide
       Combo.AddItem Format(vbNormalFocus, "(0)") & " vbNormalFocus"
       Combo.ItemData(Combo.NewIndex) = vbNormalFocus
       Combo.AddItem Format(vbMinimizedFocus, "(0)") & " vbMinimizedFocus"
       Combo.ItemData(Combo.NewIndex) = vbMinimizedFocus
       Combo.AddItem Format(vbMaximizedFocus, "(0)") & " vbMaximizedFocus"
       Combo.ItemData(Combo.NewIndex) = vbMaximizedFocus
       Combo.AddItem Format(vbNormalNoFocus, "(0)") & " vbNormalNoFocus"
       Combo.ItemData(Combo.NewIndex) = vbNormalNoFocus
       Combo.AddItem Format(vbMinimizedNoFocus, "(0)") & " vbMinimizedNoFocus"
       Combo.ItemData(Combo.NewIndex) = vbMinimizedNoFocus
       Combo.ListIndex = 1
    End Sub
      

  2.   

    然后加上BAS的内容Attribute VB_Name = "Shell32"' ****************************************************************
    '  Shell32.Bas, Copyright ?996-97 Karl E. Peterson
    ' ****************************************************************
    '  You are free to use this code within your own applications, but you
    '  are expressly forbidden from selling or otherwise distributing this
    '  source code without prior written consent.
    ' ****************************************************************
    '  Three methods to "Shell and Wait" under Win32.
    '  One deals with the infamous "Finished" behavior of Win95.
    '  Fourth method that simply shells and returns top-level hWnd.
    ' ****************************************************************
    Option ExplicitPrivate 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
    Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As LongPrivate Const STILL_ACTIVE = &H103
    Private Const PROCESS_QUERY_INFORMATION = &H400
    Private Const SYNCHRONIZE = &H100000Public Const WAIT_FAILED = -1&        'Error on call
    Public Const WAIT_OBJECT_0 = 0        'Normal completion
    Public Const WAIT_ABANDONED = &H80&   '
    Public Const WAIT_TIMEOUT = &H102&    'Timeout period elapsed
    Public Const IGNORE = 0               'Ignore signal
    Public Const INFINITE = -1&           'Infinite timeoutPublic Const SW_HIDE = 0
    Public Const SW_SHOWNORMAL = 1
    Public Const SW_SHOWMINIMIZED = 2
    Public Const SW_SHOWMAXIMIZED = 3
    Public Const SW_SHOWNOACTIVATE = 4
    Public Const SW_SHOW = 5
    Public Const SW_MINIMIZE = 6
    Public Const SW_SHOWMINNOACTIVE = 7
    Public Const SW_SHOWNA = 8
    Public Const SW_RESTORE = 9Private Const WM_CLOSE = &H10
    Private Const GW_HWNDNEXT = 2
    Private Const GW_OWNER = 4Public Function ShellAndWait(ByVal JobToDo As String, Optional ExecMode, Optional TimeOut) As Long
       '
       ' Shells a new process and waits for it to complete.
       ' Calling application is totally non-responsive while
       ' new process executes.
       '
       Dim ProcessID As Long
       Dim hProcess As Long
       Dim nRet As Long
       Const fdwAccess = SYNCHRONIZE   If IsMissing(ExecMode) Then
          ExecMode = vbMinimizedNoFocus
       Else
          If ExecMode < vbHide Or ExecMode > vbMinimizedNoFocus Then
             ExecMode = vbMinimizedNoFocus
          End If
       End If   On Error Resume Next
          ProcessID = Shell(JobToDo, CLng(ExecMode))
          If Err Then
             ShellAndWait = vbObjectError + Err.Number
             Exit Function
          End If
       On Error GoTo 0   If IsMissing(TimeOut) Then
          TimeOut = INFINITE
       End If   hProcess = OpenProcess(fdwAccess, False, ProcessID)
       nRet = WaitForSingleObject(hProcess, CLng(TimeOut))
       Call CloseHandle(hProcess)   Select Case nRet
          Case WAIT_TIMEOUT: Debug.Print "Timed out!"
          Case WAIT_OBJECT_0: Debug.Print "Normal completion."
          Case WAIT_ABANDONED: Debug.Print "Wait Abandoned!"
          Case WAIT_FAILED: Debug.Print "Wait Error:"; Err.LastDllError
       End Select
       ShellAndWait = nRet
    End FunctionPublic Function ShellAndLoop(ByVal JobToDo As String, Optional ExecMode) As Long
       '
       ' Shells a new process and waits for it to complete.
       ' Calling application is responsive while new process
       ' executes. It will react to new events, though execution
       ' of the current thread will not continue.
       '
       Dim ProcessID As Long
       Dim hProcess As Long
       Dim nRet As Long
       Const fdwAccess = PROCESS_QUERY_INFORMATION   If IsMissing(ExecMode) Then
          ExecMode = vbMinimizedNoFocus
       Else
          If ExecMode < vbHide Or ExecMode > vbMinimizedNoFocus Then
             ExecMode = vbMinimizedNoFocus
          End If
       End If   On Error Resume Next
          ProcessID = Shell(JobToDo, CLng(ExecMode))
          If Err Then
             ShellAndLoop = vbObjectError + Err.Number
             Exit Function
          End If
       On Error GoTo 0   hProcess = OpenProcess(fdwAccess, False, ProcessID)
       Do
          GetExitCodeProcess hProcess, nRet
          DoEvents
          Sleep 100
       Loop While nRet = STILL_ACTIVE
       Call CloseHandle(hProcess)   ShellAndLoop = nRet
    End FunctionPublic Function ShellAndClose(ByVal JobToDo As String, Optional ExecMode) As Long
       '
       ' Shells a new process and waits for it to complete.
       ' Calling application is responsive while new process
       ' executes. It will react to new events, though execution
       ' of the current thread will not continue.
       '
       ' Will close a DOS box when Win95 doesn't. More overhead
       ' than ShellAndLoop but useful when needed.
       '
       Dim ProcessID As Long
       Dim PID As Long
       Dim hProcess As Long
       Dim hWndJob As Long
       Dim nRet As Long
       Dim TitleTmp As String
       Const fdwAccess = PROCESS_QUERY_INFORMATION   If IsMissing(ExecMode) Then
          ExecMode = vbMinimizedNoFocus
       Else
          If ExecMode < vbHide Or ExecMode > vbMinimizedNoFocus Then
             ExecMode = vbMinimizedNoFocus
          End If
       End If   On Error Resume Next
          ProcessID = Shell(JobToDo, CLng(ExecMode))
          If Err Then
             ShellAndClose = vbObjectError + Err.Number
             Exit Function
          End If
       On Error GoTo 0   hWndJob = FindWindow(vbNullString, vbNullString)
       Do Until hWndJob = 0
          If GetParent(hWndJob) = 0 Then
             Call GetWindowThreadProcessId(hWndJob, PID)
             If PID = ProcessID Then Exit Do
          End If
          hWndJob = GetWindow(hWndJob, GW_HWNDNEXT)
       Loop   hProcess = OpenProcess(fdwAccess, False, ProcessID)
       Do
          TitleTmp = Space(256)
          nRet = GetWindowText(hWndJob, TitleTmp, Len(TitleTmp))
          If nRet Then
             TitleTmp = UCase(Left(TitleTmp, nRet))
             If InStr(TitleTmp, "FINISHED") = 1 Then
                Call SendMessage(hWndJob, WM_CLOSE, 0, 0)
             End If
          End If      GetExitCodeProcess hProcess, nRet
          DoEvents
          Sleep 100
       Loop While nRet = STILL_ACTIVE
       Call CloseHandle(hProcess)   ShellAndClose = nRet
    End FunctionPublic Function hWndShell(ByVal JobToDo As String, Optional ExecMode) As Long
       '
       ' Shells a new process and returns the hWnd
       ' of its main window.
       '
       Dim ProcessID As Long
       Dim PID As Long
       Dim hProcess As Long
       Dim hWndJob As Long   If IsMissing(ExecMode) Then
          ExecMode = vbMinimizedNoFocus
       Else
          If ExecMode < vbHide Or ExecMode > vbMinimizedNoFocus Then
             ExecMode = vbMinimizedNoFocus
          End If
       End If   On Error Resume Next
          ProcessID = Shell(JobToDo, CLng(ExecMode))
          If Err Then
             hWndShell = 0
             Exit Function
          End If
       On Error GoTo 0   hWndJob = FindWindow(vbNullString, vbNullString)
       Do While hWndJob <> 0
          If GetParent(hWndJob) = 0 Then
             Call GetWindowThreadProcessId(hWndJob, PID)
             If PID = ProcessID Then
                hWndShell = hWndJob
                Exit Do
             End If
          End If
          hWndJob = GetWindow(hWndJob, GW_HWNDNEXT)
       Loop
    End Function
      

  3.   

    同意楼上,
    实质是利用CreateProcess传回的进程句柄
    来WaitForSingleObject   Infinite