上面的是我的程序
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const STATUS_PENDING = &H103&
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Function RunShell(cmdline As String) As Boolean
Dim hProcess As Long
Dim ProcessID As Long
Dim ExitCodeLong As Long
Dim str1 As String
Me.Hide
ProcessID = Shell(cmdline, vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
Do
Call GetExitCodeProcess(hProcess, ExitCodeLong)
DoEvents
Loop While ExitCodeLong = STATUS_PENDING
Call CloseHandle(hProcess)
RunShell = True
Me.Show
End Function
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const STATUS_PENDING = &H103&
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Function RunShell(cmdline As String, Index As Integer) As Boolean
Dim hProcess As Long
Dim ProcessID As Long
Dim ExitCodeLong As Long
Dim str1 As String
Me.Hide
ProcessID = Shell(cmdline, vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
If hProcess = 0 Then
Select Case Index
Case 0
MsgBox "无法启动输出分析平台", vbInformation, MyTitle
Case 1
MsgBox "无法启动物理解读平台", vbInformation, MyTitle
Case 2
MsgBox "无法启动研究试验平台", vbInformation, MyTitle
Case 3
MsgBox "无法启动Micaps程序", vbInformation, MyTitle
End Select
End If
Do
Call GetExitCodeProcess(hProcess, ExitCodeLong)
DoEvents
Loop While ExitCodeLong = STATUS_PENDING
Call CloseHandle(hProcess)
RunShell = True
Me.Show
End Function