***我的分儿只为你----求助如何得到Timer控件超时，从而触发别的事件？***

Question

此问题结合同步执行来考虑。
我们知道，vb中同步执行某exe，必须等到该exe执行完才执行程序的下一条。
但可能此exe执行会没有响应（比如等待键盘输入从而中断执行或死循环等。。）
现在我的问题是：如何使用timer控件，使得如果exe在10秒内未执行完，则终止该exe线程。
否则将Timer清零。
小弟拜求思路或例程，谢谢！！附同步执行函数
Sub ShellWait(sCommandLine As String)               '等到外部程序执行完成
    Dim hShell As Long, hProc As Long, lExit As Long
    hShell = Shell(sCommandLine, vbHide)
    hProc = OpenProcess(&H400, False, hShell)
    Do
        GetExitCodeProcess hProc, lExit
        DoEvents
    Loop While lExit = &H103
End Sub

Answer 1

exe文件总是一个进程吧？监视进程，进程存在后，说明已经成功启动了这个exe文件，这个时候计时器开始工作，到10秒后若进程还存在，结束它。

Answer 2

具体代码如下：
模块代码：
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Const MAX_PATH As Integer = 260
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Public Id As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPheaplist = &H1
Public Const TH32CS_SNAPthread = &H4
Public Const TH32CS_SNAPmodule = &H8
Public Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodulePublic Function GetJingCheng(Exename As String) As String    ' 取得进程
GetJingCheng = ""Dim i As Long
Dim theloop As Long
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim Lent As Integer
Lent = Len(Exename)
GetJingCheng = "" '清空所有内容
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc)  '获取第一个进程，并得到其返回值
'i = 0
While theloop <> 0 '当返回值非零时继续获取下一个进程
'List1.AddItem proc.szExeFileIf Left(proc.szExeFile, Lent) = Exename Then '这个条件是我添加的，为什么这个条件始终不满足？
    GetJingCheng = proc.th32ProcessID                   '而进程列表中有explorer.exe，请问为什么？
End If'ReDim Preserve CjId(i)
'CjId(i) = proc.th32ProcessID
'i = i + 1
theloop = ProcessNext(snap, proc)
Wend
CloseHandle snap '关闭进程“快照”句柄
End FunctionPublic Function EndJingCheng(MyId As Long) As Long ' 结束进程
Dim i As Long
Dim Mystr As String
Dim hand As Long
hand = OpenProcess(1, True, MyId) '获取进程句柄
EndJingCheng = TerminateProcess(hand, 1) '关闭进程'刷新管理端的进程列表
'Mystr = GetJingCheng()End Function
窗体代码：
Private Sub Command1_Click()
Shell "calc.exe"
Timer1.Enabled = True
End SubPrivate Sub Form_Load()
Timer1.Interval = 1000
Timer1.Enabled = False
End SubPrivate Sub Timer1_Timer()
Dim pro As Long
Static n As Integer
On Error Resume Next
pro = GetJingCheng("calc.exe")
If pro <> 0 Then
    n = n + 1
    If n = 10 Then
        pro = GetJingCheng("calc.exe")
        If pro = 0 Then
            n = 0
            Timer1.Enabled = False
        Else
            EndJingCheng (pro)
            n = 0
        End If
    End If
End If
End Sub

Answer 3

设置一个全局变量不就可以了吗？
在 OpenProcess以后timer1.enabled=true就开始计算了。
timer1.enabled=false就停止了。
完全可以用你原来的代码，在timer1到时后TerminateProcess进程就行了。

Answer 4

当执行Exe文件时，设计Timer组件，10秒然后根据文件名关闭该进程，
Public Sub subKillProcess(ByVal strProcess As String)    Dim strComputer As String
    Dim objWMIService As Object
    Dim colProcessList
    Dim objProcess As Object
    
    On Error Resume Next
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'        strProcess = "Excel.exe"
    Set colProcessList = objWMIService.ExecQuery _
        ("Select * from Win32_Process Where Name = '" & strProcess & "'")
    For Each objProcess In colProcessList
        objProcess.Terminate
    Next
    
End Sub

Answer 5

很感激CSDN这个大家庭的热情帮助
晚上回来我再认真看程序。

Answer 6

试了一下hpygzhx520() 代码，没能实现预期要求
分析了一下，发现我的同步执行程序中有个DoEvens
所以计时器溢出不了。
所以还请大家多给给解决思路
拜谢啦~呵呵

Answer 7

将同步执行程序中的DoEvens删掉，执行
居然vb挂掉了
呼呼~~

Answer 8

MagicianLiu(魔术师·刘) 的程序中止指定进程完全正确
谢谢:-）
怎么绕开同步执行的DoEvens呢？

Answer 9

1、为了便于测试，请首先建立一个延时20s的延时程序，命名为test20s.exe
新建标准exe，在窗体上放置一个timer1。
Private Sub Form_Load()
    Timer1.Interval = 20000
    Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
    End
End Sub
生成文件：test20s.exe
关闭该工程。将test20s.exe放置在c:\下。2、新建标准exe，在窗体上放置一个command1和一个timer1
Private Sub Command1_Click()
    Timer1.Enabled = True
    ShellWait ("c:\test20s.exe") '同步执行
End SubPrivate Sub Form_Load()
    Timer1.Enabled = False
    Timer1.Interval = 10000   '计时器溢出时间设为10s
End Sub
Private Sub Timer1_Timer()
    Call subKillProcess(strTestProblemExePath) '计时器溢出中止test20.exe进程
End Sub添加模块，在模块中输入：
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPrivate Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _
lpExitCode As Long) As Long'********************************************************************************
'以下为同步执行函数
Sub ShellWait(sCommandLine As String)               '等到外部程序执行完成
    Dim hShell As Long, hProc As Long, lExit As Long
    hShell = Shell(sCommandLine, vbHide)
    hProc = OpenProcess(&H400, False, hShell)
    Do
         GetExitCodeProcess hProc, lExit
         DoEvents
    Loop While lExit = &H103
End Sub'********************************************************************************
'以下为MagicianLiu的中止进程代码
Public Sub subKillProcess(ByVal strProcess As String)
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colProcessList
    Dim objProcess As Object
    
    On Error Resume Next
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery _
        ("Select * from Win32_Process Where Name = '" & strProcess & "'")
    For Each objProcess In colProcessList
        objProcess.Terminate
    Next
End Sub********************************************
按command1执行，发现10s后（计时器溢出后），test20s.exe仍在执行。
怀疑是DoEvens的原因，求解决方案~~~
谢谢！！

Answer 10

当然了，hpygzhx520的代码中止exe进程也是100%没问题的
但也是不能在10s（即定时器溢出）的时候中止exe进程。

Answer 11

用TerminateProcess就可以了，只是NT内核系统需注意一个权限问题，这类NT下关闭进程代码网上很多。你这里还有一个细节问题，API常数请用系统习惯性的常量名表示，不然光看&H400与&H103这样的值，实在不知所云，别人也懒着去查，这是些什么值了。GetExitCodeProcess要查的退出码是&H103，所以TerminateProcess第二个参数应该也指定为该值，否则那里会是个死循环！不过，我实在无心了解这个&H103是什么意思，你最好查查，它代表什么！简单一点的方案，你自已定个结束变量，在TerminateProcess后，置为True，那个subKillProcess的Do循环中多加上一个退出条件就可以了，不要死抱着退出码不放！

Answer 12

测试正常啊
Private Sub Form_Load()
    Timer1.Interval = 0
End SubPrivate Sub Timer1_Timer()
    subKillProcess ("calc.exe")
End Sub
Public Sub subKillProcess(ByVal strProcess As String)
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colProcessList
    Dim objProcess As Object
    
    On Error Resume Next
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery _
        ("Select * from Win32_Process Where Name = '" & strProcess & "'")
    For Each objProcess In colProcessList
        objProcess.Terminate
    Next
End Sub

Answer 13

Private Sub Command1_Click()
    Shell "calc", vbNormalFocus
    Timer1.Interval = 10000
End Sub

Answer 14

小吉，之前你帮我解决过问题，现在又来帮忙，一并感谢，赫赫~~~
GetExitCodeProcess要查的退出码是&H103，它表示STILL_ACTIVE（仍然活动）。
OpenProcess的参数&H400的意思是：PROCESS_ALL_ACCESS。现在好困，睡觉先~~~~~呵呵
希望小吉还是给我指点一下，我自认很菜，呵呵~~~
请教请教~~~！

Answer 15

贴几张mm图片给大家放松一下：
http://www.avl.com.cn/life/sheying123/050128/zipai/1.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/2.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/3.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/4.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/5.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/6.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/7.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/8.jpg
http://www.avl.com.cn/life/sheying123/050128/zipai/9.jpg我喜欢3，7，8hoho。。

Answer 16

其实还是用一个公用变量比较简单，在ShellWait的循环体内增加一条判断的语句，当该变量值为真时即条出循环体外，而timer控件在设定的时间到达时给该变量赋值为真即可，timer在执行ShellWait前启动。

Answer 17

调出来了，开心，方法正如zhujiechang(小朱)，homezj(小吉) ，Fanks(铁面人) 三位热情的“星”级高手的思路，设全局变量。严重感谢！
同时，异常感谢MagicianLiu(魔术师·刘）以及hpygzhx520() 的代码，加入收藏了，谢谢！小弟结帐~
再加40分，一共100分
呵呵~~~开心

Answer 18

小弟还有一贴，希望各位大哥继续帮忙啊，分多多，hoho
http://community.csdn.net/Expert/topic/4143/4143527.xml?temp=.7158625