一个常见的问题，大家都进来看看，或许你们以前也碰到过的

[无·法]

先看我的代码：
Private Sub Command1_Click()
Dim strFileName$
strFileName = "test.exe"
Call Shell(strFileName, 1)
Call terminateProcess(strFileName) '如果文件启动时间较长，terminateProcess过程就会出错，主要是文件还没启动好在进程中显示
Call Kill(strFileName) '如果上一步执行的时候过长就会出现“拒绝的权限”的错误
End Sub

Private Sub terminateProcess(ByVal proName As String)
Dim objWMIService, colProcessList, objProcess
Set objWMIService = GetObject("winmgmts:" & "{impersonationlevel=impersonate}!\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name='" & proName & "'")
If colProcessList.Count <> 0 Then
For Each objProcess In colProcessList
objProcess.Terminate
Next
End If
End Sub

相关问题已经写在后面的注释里，大家看看，可以用什么方法解决这种类型的错误？

[用户 昵称]

加一段延时

[用户 昵称]

Private Sub Command1_Click()
    Dim strFileName$
    strFileName = "test.exe"
    Call Shell(strFileName, 1)
    Dim start As Double
    start = Timer
    Do
        DoEvents
    Loop While Timer - start < 2
    Call terminateProcess(strFileName) '如果文件启动时间较长，terminateProcess过程就会出错，主要是文件还没启动好在进程中显示
    Call Kill(strFileName) '如果上一步执行的时候过长就会出现“拒绝的权限”的错误
End Sub

[zzyong00]

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long


Private Sub Command1_Click() 
    Dim strFileName$ ,PHdl as long
    strFileName = "test.exe" 
    PHdl =Shell(strFileName, 1) 
    WaitForSingleObject  PHdl ,-1
    Call terminateProcess(strFileName) '如果文件启动时间较长，terminateProcess过程就会出错，主要是文件还没启动好在进程中显示 
    Call Kill(strFileName) '如果上一步执行的时候过长就会出现“拒绝的权限”的错误 
End Sub 

[cbm6666]

启动程序 终止程序 干掉程序 楼主想诉求的是什么 ? 你的终极目的是什么 ? 思路搞错了吧 ?

人还没到就想杀人? 你杀谁 ? 不就是要等吗 ?

[cbm6666]

Private Declare Function TerminateProcess Lib "kernel32" (ByVal Hprocess As Long, ByVal uExitCode As Long) As Long

还有, 提醒楼主一点, 自定义涵数的名称可不是你随便高兴想怎么订就怎么订的, 看到上面那个API了吗 ?

[letusgo1234567890]

建议加段延时程序，建议过个15秒 30秒的再强制关，时间短了，有些机子慢就会出错了

[无·法]

我的目的就是依次无误的执行下来，道理我也明白，我也是用的延时解决，不过我用的是sleep函数，这有个缺点，程序启动的时间是不定的，比如notepad.exe和winword.exe，所以我期待用其它的方法解决，而不是随便sheep 1000或者2000的。cbm666老师，我在vb吧看到你解决过类似问题的，好像是用了个xdel.com这个外部命令，但是这样为了一个简单的需求而让自己捆个大“包袱”总感觉不好吧

[cbm6666]

'以下代码比上面的都长, 但是这个代码是一个正规而且严谨的代码
'在进程里面检查的exe是不含路径的Exe文件名称,而Kill需要的是全路径的名称,楼主的似乎是搞错了吧?


Option Explicit
Private 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
Const PROCESS_TERMINATE = 1
Private Declare Function TerminateProcess Lib "kernel32" (ByVal Hprocess As Long, ByVal uExitCode As Long) As Long
Dim Proid&, Hprocess&, Starttm&, Exenm$, Chknm$, objWMIService, colProcesslist, StartProg As Boolean
Private Sub Command1_Click()
Exenm = "c:\calc.exe" '含路径的EXE文件名称
Chknm = Mid(Exenm, InStrRev(Exenm, "\") + 1) '不含路径的EXE文件名称
StartProg = False
Proid = Shell(Exenm, vbNormalFocus) '运行c:\calc.exe并取得它的Proid
Starttm = Timer '开始延时
Do
DoEvents
If Isrunexe(Chknm) Then StartProg = True: Exit Do '检查程序是否已成功运行
Loop Until Timer >= Starttm + 3 '最多等3秒,否则认定运行失败,时间长短自己看着办
If StartProg Then '如果程序已成功运行
Call CloseExe(Proid) '关掉这个Proid的进程(c:\calc.exe)
Starttm = Timer '开始延时
Do
DoEvents
If Not Isrunexe(Chknm) Then StartProg = False: Exit Do '如果程序已成功关掉
Loop Until Timer >= Starttm + 3 '最多等3秒,否则认定关不了,时间长短自己看着办
If StartProg =False Then Kill Exenm '确认程序已关掉,干掉c:\calc.exe
End If
End Sub

Private Function Isrunexe(Enm As String) As Boolean
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcesslist = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & Enm & "'")
Isrunexe = IIf(colProcesslist.Count > 0, True, False)
Set objWMIService = Nothing
Set colProcesslist = Nothing
End Function

Sub CloseExe(Pid As Long)
Hprocess = OpenProcess(PROCESS_TERMINATE, False, Pid)
TerminateProcess Hprocess, 1
CloseHandle Hprocess
End Sub

[zzyong00]

楼主，用WaitForSingleObject 满足不了你吗？

[knowledge_Is_Life]

支持搂主，收藏