vb列举进程代码 - 站长资源库

答案：

添加如图控件

Command1为kill process键

Command2为刷新键

其余的为系统默认名称

form1代码:

Option Explicit
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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPheaplist = &H1
Private Const TH32CS_SNAPthread = &H4
Private Const TH32CS_SNAPmodule = &H8
Private Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
Private Const MAX_PATH As Integer = 260
Private Const PROCESS_TERMINATE = &H1

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 Function RefreshProcess()
On Error Resume Next
List1.Clear
Dim i As Long
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim exename As String
Dim theloop As Long
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc) '获取第一个进程，并得到其返回值
i = 0
While theloop <> 0 '当返回值非零时继续获取下一个进程
exename = proc.szExeFile
List1.AddItem exename
theloop = ProcessNext(snap, proc)
Wend
End Function
Public Sub CloseProcess(ProName As String) '关闭指定名称的程序例qq.exe
On Error Resume Next
Dim i As Long
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim exename, killname As String
Dim theloop As Long
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc) '获取第一个进程，并得到其返回值
i = 0
While theloop <> 0 '当返回值非零时继续获取下一个进程
exename = proc.szExeFile
killname = ProName & "*"
If LCase(exename) Like LCase(killname) Then
Dim hand As Long
hand = OpenProcess(PROCESS_TERMINATE, True, proc.th32ProcessID)
TerminateProcess hand, 0 '关闭进程
'MsgBox "系统已经强制结束了" & ProName & "程序！", vbExclamation, "系统提示"
End If
theloop = ProcessNext(snap, proc)
Wend
CloseHandle snap '关闭进程“快照”句柄
RefreshProcess
End Sub

Private Sub Command1_Click()
CloseProcess Text1.Text
End Sub

Private Sub Command2_Click()
RefreshProcess
End Sub

Private Sub Form_Load()
RefreshProcess
Dim ret As Long
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc)
idHotKey = 1
Modifiers = MOD_ALT + MOD_CONTROL
uVirtKey = vbKeyX
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)
End Sub

Private Sub Form_Resize()
On Error Resume Next
'Label1.Left = 60
'Label1.Width = 1155
Command1.Left = Form1.Width - Command1.Width - 140
'Command1.Top = 0
'Text1.Top = 0
Text1.Width = Form1.Width - 2490
List1.Width = Form1.Width - 120
List1.Height = Form1.Height - List1.Top - 825
Command2.Top = List1.Top + List1.Height + 10
Command2.Left = Form1.Width - 2000
End Sub

Private Sub List1_Click()
Text1.Text = List1.Text
End Sub
Module1代码:

Option Explicit

Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function RegisterHotKey Lib "User32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "User32" (ByVal hwnd As Long, ByVal id As Long) As Long
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

Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-4)
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPheaplist = &H1
Private Const TH32CS_SNAPthread = &H4
Private Const TH32CS_SNAPmodule = &H8
Private Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
Private Const MAX_PATH As Integer = 260
Private Const PROCESS_TERMINATE = &H1

Public preWinProc As Long
Public Modifiers As Long, uVirtKey As Long, idHotKey As Long

Private Type t2Int
lWord As Integer
hWord As Integer
End Type

Private Function RefreshProcess()
On Error Resume Next
Form1.List1.Clear
Dim i As Long
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim exename As String
Dim theloop As Long
snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc) '获取第一个进程，并得到其返回值
i = 0
While theloop <> 0 '当返回值非零时继续获取下一个进程
exename = proc.szExeFile
Form1.List1.AddItem exename
theloop = ProcessNext(snap, proc)
Wend
End Function
Public Sub CloseProcess(ProName As String) '关闭指定名称的程序例qq.exe
On Error Resume Next
Dim i As Long
Dim proc As PROCESSENTRY

上一个：VB是什么？
下一个：VB 数据库实例

更多图片编程知识: