Question

vb检测指定进程是否存在

比如我写个程序：
1.进程中是否存在QQ.exe这个程序，如果存在lbl1.caption=1
2.不存在lbl1.caption=0
我不要检测标题那种！

Answer 1

'来个短小的，真正检测进程：
Private Sub Command1_Click()
On Error Resume Next
Dim s, mFind As Boolean
Dim objWMIService, colProcessList, objProcess
s = "QQ.exe"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name='" & s & "'")
For Each objProcess In colProcessList
mFind = True '检测到则标识为真
objProcess.Terminate
Next
mFind = IIf(True, lbl1.Caption = 1, 0) '结果在lbl1中显示
Set objProcess = Nothing
Set colProcessList = Nothing
Set objWMIService = Nothing
End Sub

Answer 2

方法：在窗体上添加一个listbox,并改名为lstPro，设为不可见；添加一个命令按钮，改名为cmdCheck。建一个label，命名为lbl1

代码：
'-------------
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const MAX_PATH As Integer = 260
Private Const TH32CS_SNAPheaplist = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPthread = &H4
Private Const TH32CS_SNAPmodule = &H8
Private Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule

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 Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Byte
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 1024
End Type

Private Sub cmdCheck_Click()
Dim i As Long, lPid As Long, FileName As String, TmpStr As String, TmpLong As Long
Dim Proc As PROCESSENTRY32
Dim hSnapShot As Long
Dim Mode As MODULEENTRY32
Dim mSnapshot As Long
Dim lInfoSize As Long, arrInfo() As Byte, lpInfoBlock As Long, arrTemp(4) As Byte
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
lstPro.Clear
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0)
Proc.dwSize = Len(Proc)
lPid = ProcessFirst(hSnapShot, Proc)
i = 0
Do While lPid <> 0
TmpStr = Trim(Left(Proc.szExeFile, InStr(Proc.szExeFile, Chr(0)) - 1))
TmpLong = InStr(TmpStr, "\")
Do While TmpLong <> 0
TmpStr = Mid(TmpStr, TmpLong + 1)
TmpLong = InStr(TmpStr, "\")
Loop
lstPro.AddItem TmpStr
i = i + 1
lPid = ProcessNext(hSnapShot, Proc)
Loop
CloseHandle hSnapShot
Dim exist
exist = 0
For i99 = 0 To lstPro.ListCount - 1
If UCase(lstPro.List(i99)) = "QQ.EXE" Then
exist = 1
Exit For
End If
Next
lbl1.Caption = exist
End Sub
'------------------
以上就是......

Answer 3

sdf

Answer 4

声明API
----------------------------------------------
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 ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Function exitproc(ByVal exefile As String) As Boolean
exitproc = False
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = exefile Then
exitproc = True
Exit Do
End If
'Retrieve information about the next process recorded in our system snapshot
r = Process32Next(hSnapShot, uProcess)
Loop
End Function

-----------------------------
程序代码

Private Sub Form_Load()
Timer1.Interval = 100 '设定监测频率(单位毫秒)
End Sub

Private Sub Timer1_Timer()
a = exitproc("QQ.EXE") '监控指定的进程
If a = True Then
MsgBox "发现进程中有QQ.EXE" '有指定进程发出信息
Else
End If
End Sub

时间关系有点缺陷 扫描到会一直弹出信息 ...还有就是隐藏的进程貌似无法扫描到...自已改改简单的