VB代码VB小程序：通过枚举进程显示所有进程、隐藏进程、进程路径.doc

VB代码VB小程序：通过枚举进程显示所有进程、隐藏进程、进程路径本小程序采用枚举进程的方法，显示所有进程，也能显示隐藏进程。同时，能显示进程的完整路径。有意思的是，一些已经结束的进程，同样可以显示。以下是程序运行截图：以下是 VB6 代码，在 WinXP 调试通过需在窗体放置以下 5 个控件，不必设置任何属性，全部采用默认设置：Command1、List1、Check1、Timer1、Label1本人原创，转载请注明来源：/100bd/blog/item/c4199fedda35ba0763d09f6b.htmlPrivate Type tyProcpID As Long: pName As String: pPath As String: pHide As StringEnd TypeDim ctP() As tyProc, ctPs As LongPrivate Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPrivate Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef lpcbNeeded As Long) As LongPrivate 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 LongPrivate Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As LongPrivate Declare Function GetProcessImageFileName Lib "psapi.dll" Alias "GetProcessImageFileNameA" (ByVal hProcess As Long, ByVal lpImageFileName As String, ByVal nSize As Long) As LongPrivate Const PROCESS_ALL_ACCESS = &H1F0FFFPrivate Const PROCESS_QUERY_INFORMATION = &H400Private Const PROCESS_VM_READ = &H10Private Const PROCESS_CREATE_PROCESS = &H80Private Const PROCESS_CREATE_THREAD = &H2Private Const PROCESS_DUP_HANDLE = &H40Private Const PROCESS_QUERY_INFORMATION = &H400Private Const PROCESS_QUERY_LIMITED_INFORMATION = &H1000Private Const PROCESS_SET_QUOTA = &H100Private Const PROCESS_SET_INFORMATION = &H200Private Const PROCESS_SUSPEND_RESUME = &H800Private Const PROCESS_TERMINATE = &H1Private Const PROCESS_VM_OPERATION = &H8Private Const PROCESS_VM_READ = &H10Private Const PROCESS_VM_WRITE = &H20以下是在 NT 系统中提升当前进程权限的代码 =系统级权限,可以：PROCESS_ALL_ACCESS OpenProcessToken、LookupPrivilegevalue、AdjustTokenPrivilegesPrivate Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPrivate Declare Function GetCurrentProcess Lib "kernel32" () As LongPrivate Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As LongPrivate 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 LongPrivate Type LUIDUsedPart As LongIgnoredForNowHigh32BitPart As LongEnd TypePrivate Type TOKEN_PrivilegesPrivilegeCount As LongTheLuid As LUIDAttributes As LongEnd TypePublic Sub AdjustPrivilege()NT系统：提升权限Dim dl As Long, CurP As Long, nToKen As Long, nLuid As LUIDDim OldTKP As TOKEN_Privileges, NewTKP As TOKEN_PrivilegesDim pName As StringConst TOKEN_Adjust_Privileges = &H20Const TOKEN_Query = &H8Const 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、SeUnsolicitedInputPrivilegepName = "SeDebugPrivilege"dl = LookupPrivilegeValue("", pName, nLuid)NewTKP.PrivilegeCount = 1NewTKP.TheLuid = nLuidNewTKP.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.NameCall AdjustPrivilege 提升本进程权限Timer1.Interval = 10Check1.Caption = "自动刷新": Check1.Value = 1End SubPrivate Sub Check1_Click()Timer1.Enabled = Check1.Value = 1End SubPrivate Sub Timer1_Timer()Static S As Long, S1 As LongDim nTai As StringS1 = S1 + 1If S1 > 2 ThenS1 = 0nTai = ""S = S + 1If S > 8 Then S = 1Label1.Caption = Mid(nTai, S, 1) 动画显示End IfCall ShowProcEnd SubPrivate Sub Command1_Click()List1.Clear: List1.RefreshCall ShowProcEnd SubPrivate Sub Form_Resize()Dim H1 As Single, T As SingleOn Error Resume NextH1 = Me.TextHeight("A")Command1.Move H1, H1, H1 * 4, H1 * 2Label1.Move H1 * 6, H1 * 1.5, H1, H1Check1.Move H1 * 8, H1, H1 * 8, H1 * 2T = Command1.Top + Command1.Height + H1 * 0.5List1.Move 0, T, Me.ScaleWidth, Me.ScaleHeight - TEnd Sub本人原创，转载请注明来源：/100bd/blog/item/c4199fedda35ba0763d09f6b.htmlPrivate Sub ShowProc()Dim pID(1023) As Long, Ps As Long, dwDesiredAccess As LongDim cbNeeded As Long, P As Long, hModule As LongDim hProcess As Long, nStr As String, I As LongDim IsChange As Boolean, P2() As tyProc, Ps2 As LongOn Error Resume NextdwDesiredAccess = PROCESS_QUERY_INFORMATION Or PROCESS_VM_READPs2 = ctPs: P2 = ctPctPs = 1: ReDim ctP(0 To 1)ctP(1).pName = "System Process"nStr = String(1024, 0)进程ID的数组，数组的大小，返回实际进程数组的大小If EnumProcesses(pID(0), 4& * 1024, cbNeeded) <> 0 ThenPs = cbNeeded 4 进程总数For P = 0 To &HFFFF& Step 4hProcess = OpenProcess(dwDesiredAccess, 0, P) 返回指定进程的句柄If hProcess <> 0 ThenctPs = ctPs + 1: ReDim Preserve ctP(0 To ctPs)ctP(ctPs).pHide = "隐藏"For I = 0 To Ps - 1If P = pID(I) Then ctP(ctPs).pHide = "": Exit ForNext InStr 返回主模块全名：每个进程的第一模块即为进程主模块If EnumProcessModules(hProcess, hModule, 4&, 0&) <> 0 ThenGetModuleFileNameEx hProcess, hModule, nStr, 1024Else 型如：DeviceHarddiskVolumeGetProcessImageFileName hProcess, nStr, 1024End IfCloseHandle 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 WithEnd IfNextEnd IfList1.ClearFor P = 1 To ctPsnStr = AddSpace(P, 4) & ProcStr(ctP(P) 合成显示条目If P > List1.ListCount ThenList1.AddItem nStrList1.ListIndex = List1.NewIndexElseIf nStr <> List1.List(P - 1) Then List1.List(P - 1) = nStrEnd IfNext删除多余条目For P = List1.ListCount - 1 To ctPs Step -1List1.RemoveItem PNextEnd SubPrivate Function ProcStr(P As tyProc) As StringProcStr = AddSpace(P.pID) & AddSpace(P.pHide, 6) & AddSp