ShellExecute 函数是通过资源管理器来启动程序, 而资源管理器启动程序之后,
并没有将 Process ID 或 Process Handle 传回来。所以比较难。
并没有将 Process ID 或 Process Handle 传回来。所以比较难。
解决方案 »
- 这个数据怎样写到数据库里?
- 请问怎么用API代替SSTAB的功能呢?
- 请教大虾:vb中如何实现数据库的备份和恢复功能,数据库用access2000(紧急任务-30分)
- csdn的大哥大姐救命! vb+excel的问题
- 在不关闭程序的前提下,如何将窗体从内存中卸载呢?
- 如何在VB中备份及恢复SQL数据库,用SQL当后台数据库(请高手给出代码,谢谢!)
- 怎样设置键盘的响应时间?(近来就有分啊)
- 如何将文件读入ComboBox控件中-----(在线等待)
- 简单问题,关于传递文件
- 帮忙运行一下代码!!!!急!急!急!急!急!急!急!急!急!(在线等候)
- 请问有什么办法实现在一条SQL语句里同时对两个不同的数据库操作?数据库高手快来!!!!
- 有关DNS配置问题?急!!
下面是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
' 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
实质是利用CreateProcess传回的进程句柄
来WaitForSingleObject Infinite