VB中一个命令按钮调用shell函数打开外部程序后,该命令按钮失效,外部程序关闭后,该命令按钮恢复正常

如题所述

运行后得到PID值,然后判断PID值关闭即可。

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
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000

Private Sub Command1_Click()
    Command1.Enabled = False
    Dim i As Long
    Dim r As Long
    Dim p As Long
    i = Shell("notepad.exe", vbNormalFocus)
    p = OpenProcess(SYNCHRONIZE, False, i)
    r = WaitForSingleObject(p, INFINITE)
    r = CloseHandle(p)
    Command1.Enabled = True
End Sub

追问

但是这样单机命令按钮后不光命令按钮失效,原窗体也失效了,怎么才能不让原窗体失效呢?

追答

改下等待方式,添加Doevents即可:

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
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
 
Private Sub Command1_Click()
    Command1.Enabled = False
    Dim i As Long
    Dim r As Long
    Dim p As Long
    i = Shell("notepad.exe", vbNormalFocus)
    p = OpenProcess(&H400, False, i)
    Do
        Call GetExitCodeProcess(p, exitcode)
        DoEvents
    Loop While exitcode = &H103
    Call CloseHandle(p)
    Command1.Enabled = True
End Sub

温馨提示:内容为网友见解,仅供参考
无其他回答
相似回答