狠狠色丁香婷婷综合尤物/久久精品综合一区二区三区/中国有色金属学报/国产日韩欧美在线观看 - 国产一区二区三区四区五区tv

　　本小程序采用枚舉進程的方法，顯示所有進程，也能顯示隱藏進程。同時，能顯示進程的完整路徑。
　　有意思的是，一些已經結束的進程，同樣可以顯示。
　　以下是程序運行截圖：
　

''''以下是 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