Question

如何用VB来检测一个程序是否在运行，并且返回一个值

说一下详细用法

Answer 1

'添加 Command1

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private 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
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)
Dim chkfile$, aa$, r
Private Sub Form_Load()
Me.AutoRedraw = True
Call addjclist
End Sub

Private Sub Command1_Click()
Call addjclist
chkfile = "Calc.exe"
If InStr(aa, UCase(chkfile)) > 0 Then
rtn = MsgBox("您确定要终止 " & procname & " 吗？", vbYesNo, "强制关闭进程")
If rtn = 6 Then
SendMessage hProcess, WM_CLOSE, 0, 0 '关闭此进程
End If
Else
MsgBox chkfile & " 没运行"
End If
End Sub

Sub addjclist()
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
aa = ""
Do While r
aa = aa & Trim(uProcess.szExeFile) & " "
r = Process32Next(hSnapShot, uProcess)
Loop
aa = UCase(aa)
CloseHandle hSnapShot
End Sub

'************************** 代码 2 简单的方式

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 Any) As Long
Const WM_CLOSE = &H10
Dim hProcess&, procname$

Private Sub Command1_Click()
procname = "计算器"
hProcess = FindWindow(vbNullString, procname)
If hProcess > 0 Then
rtn = MsgBox("您确定要终止 " & procname & " 吗？", vbYesNo, "强制关闭进程")
If rtn = 6 Then
SendMessage hProcess, WM_CLOSE, 0, 0 '关闭此进程
End If
Else
MsgBox procname & "没运行"
End If
End Sub