本小程序采用枚举进程的方法，显示所有进程，也能显示隐藏进程。同时，能显示进程的完整路径。
　　有意思的是，一些已经结束的进程，同样可以显示。
　　以下是程序运行截图：
　

''''以下是 VB6 代码，在 WinXP 调试通过
'需在窗体放置以下 5 个控件，不必设置任何属性，全部采用默认设置：
' Command1、List1、Check1、Timer1、Label1
Private Type tyProc
pID As Long: pName As String: pPath As String: pHide As String
End Type
Dim ctP() As tyProc, ctPs As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef lpcbNeeded As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetProcessImageFileName Lib "psapi.dll" Alias "GetProcessImageFileNameA" (ByVal hProcess As Long, ByVal lpImageFileName As String, ByVal nSize As Long) As Long

Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_CREATE_PROCESS = &H80
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_DUP_HANDLE = &H40
'Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_QUERY_LIMITED_INFORMATION = &H1000
Private Const PROCESS_SET_QUOTA = &H100
Private Const PROCESS_SET_INFORMATION = &H200
Private Const PROCESS_SUSPEND_RESUME = &H800
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_VM_OPERATION = &H8
'Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20

'以下是在 NT 系统中提升当前进程权限的代码 ================================
'系统级权限,可以：PROCESS_ALL_ACCESS OpenProcessToken、LookupPrivilegevalue、AdjustTokenPrivileges
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_Privileges, ByVal BufferLength As Long, PreviousState As TOKEN_Privileges, ReturnLength As Long) As Long
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_Privileges
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type

Public Sub AdjustPrivilege()
'NT系统：提升权限
Dim dl As Long, CurP As Long, nToKen As Long, nLuid As LUID
Dim OldTKP As TOKEN_Privileges, NewTKP As TOKEN_Privileges
Dim pName As String

Const TOKEN_Adjust_Privileges = &H20
Const TOKEN_Query = &H8
Const SE_Privilege_Enabled_BY_DEFAULT = &H1 '默认权限
Const SE_Privilege_Enabled = &H2 '开启权限
Const SE_Privilege_USED_FOR_ACCESS = &H80000000 '所有访问权限

'获取当前进程的一个句柄
CurP = GetCurrentProcess()
'打开进程令牌：用 nToKen 获得进程访问令牌的句柄
dl = OpenProcessToken(CurP, (TOKEN_Adjust_Privileges Or TOKEN_Query), nToKen)

'用 nLuid 返回指定权限的 LUID 结构
'权限名称：SeDebugPrivilege、SeShutdownPrivilege、SeRestorePrivilege、SeBackupPrivilege、SeUnsolicitedInputPrivilege
pName = "SeDebugPrivilege"
dl = LookupPrivilegeValue("", pName, nLuid)

NewTKP.PrivilegeCount = 1
NewTKP.TheLuid = nLuid
NewTKP.Attributes = SE_Privilege_Enabled

'调整令牌权限
dl = AdjustTokenPrivileges(nToKen, False, NewTKP, Len(NewTKP), OldTKP, 0&)
End Sub
'===================

Private Sub Form_Load()
Me.Font.Name = "宋体": Me.Caption = "枚举进程"
Command1.Caption = "刷新"
List1.Font.Name = Me.Font.Name
Call AdjustPrivilege '提升本进程权限
Timer1.Interval = 10
Check1.Caption = "自动刷新": Check1.Value = 1
End Sub

Private Sub Check1_Click()
Timer1.Enabled = Check1.Value = 1
End Sub

Private Sub Timer1_Timer()
Static S As Long, S1 As Long
Dim nTai As String

S1 = S1 + 1
If S1 > 2 Then
S1 = 0
nTai = "↖↑↗→↘↓↙←"
S = S + 1
If S > 8 Then S = 1
Label1.Caption = Mid(nTai, S, 1) '动画显示
End If
Call ShowProc
End Sub

Private Sub Command1_Click()
List1.Clear: List1.Refresh
Call ShowProc
End Sub

Private Sub Form_Resize()
Dim H1 As Single, T As Single
On Error Resume Next
H1 = Me.TextHeight("A")
Command1.Move H1, H1, H1 * 4, H1 * 2
Label1.Move H1 * 6, H1 * 1.5, H1, H1
Check1.Move H1 * 8, H1, H1 * 8, H1 * 2
T = Command1.Top + Command1.Height + H1 * 0.5
List1.Move 0, T, Me.ScaleWidth, Me.ScaleHeight - T
End Sub


Private Sub ShowProc()
Dim pID(1023) As Long, Ps As Long, dwDesiredAccess As Long
Dim cbNeeded As Long, P As Long, hModule As Long
Dim hProcess As Long, nStr As String, I As Long

Dim IsChange As Boolean, P2() As tyProc, Ps2 As Long

On Error Resume Next
dwDesiredAccess = PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ

Ps2 = ctPs: P2 = ctP
ctPs = 1: ReDim ctP(0 To 1)
ctP(1).pName = "[System Process]"
nStr = String(1024, 0)
' 进程ID的数组，数组的大小，返回实际进程数组的大小
If EnumProcesses(pID(0), 4& * 1024, cbNeeded) <> 0 Then
Ps = cbNeeded \ 4 '进程总数
For P = 0 To &HFFFF& Step 4
hProcess = OpenProcess(dwDesiredAccess, 0, P) '返回指定进程的句柄
If hProcess <> 0 Then
ctPs = ctPs + 1: ReDim Preserve ctP(0 To ctPs)
ctP(ctPs).pHide = "隐藏"
For I = 0 To Ps - 1
If P = pID(I) Then ctP(ctPs).pHide = "": Exit For
Next I

'nStr 返回主模块全名：每个进程的第一模块即为进程主模块
If EnumProcessModules(hProcess, hModule, 4&, 0&) <> 0 Then
GetModuleFileNameEx hProcess, hModule, nStr, 1024
Else '型如：\Device\HarddiskVolume
GetProcessImageFileName hProcess, nStr, 1024
End If
CloseHandle hProcess '关闭进程的句柄

With ctP(ctPs)
.pID = P '进程 ID
.pPath = CutStr(nStr, vbNullChar) '进程路径
If Left(.pPath, 4) = "\??\" Then .pPath = Mid(.pPath, 5) '去掉“\??\”
.pName = CutStr(.pPath, "\", True) '进程名
If P = 4 And .pName = "" Then .pName = "System"
End With
End If
Next
End If

'List1.Clear
For P = 1 To ctPs
nStr = AddSpace(P, 4) & ProcStr(ctP(P)) '合成显示条目
If P > List1.ListCount Then
List1.AddItem nStr
' List1.ListIndex = List1.NewIndex
Else
If nStr <> List1.List(P - 1) Then List1.List(P - 1) = nStr
End If
Next

'删除多余条目
For P = List1.ListCount - 1 To ctPs Step -1
List1.RemoveItem P
Next
End Sub

Private Function ProcStr(P As tyProc) As String
ProcStr = AddSpace(P.pID) & AddSpace(P.pHide, 6) & AddSpace(P.pName, 20) & AddSpace(P.pPath)
End Function

Private Function AddSpace(ByVal nStr As String, Optional ByVal S As Long) As String
If S < 1 Then S = 6
S = S - LenB(StrConv(nStr, vbFromUnicode))
If S < 1 Then S = 1
AddSpace = nStr & String(S, " ")
End Function

Private Function CutStr(nStr As String, Fu As String, Optional GetRight As Boolean) As String
'GetRight=T 从右到左查找
Dim S As Long
If GetRight Then ' 从右到左查找
S = InStrRev(nStr, Fu)
If S > 0 Then CutStr = Mid(nStr, S + 1) Else CutStr = nStr
Else
S = InStr(nStr, Fu)
If S > 0 Then CutStr = Left(nStr, S - 1) Else CutStr = nStr
End If
End Function