[转载] 2000下获取进程的全路径

1. Option Explicit
   
2. '======================用于查找进程和终止进程的API函数常数定义================ =====
   
3. Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
   
4. Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
   
5. Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
   
6. Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
   
7. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
   
8. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
   
9. Const MAX_PATH As Integer = 260
   
10. Private Type PROCESSENTRY32
    
11. dwSize As Long
    
12. cntUsage As Long
    
13. th32ProcessID As Long
    
14. th32DefaultHeapID As Long
    
15. th32ModuleID As Long
    
16. cntThreads As Long
    
17. th32ParentProcessID As Long
    
18. pcPriClassBase As Long
    
19. dwFlags As Long
    
20. szExeFile As String * MAX_PATH
    
21. End Type
    
22. Const TH32CS_SNAPheaplist = &H1
    
23. Const TH32CS_SNAPPROCESS = &H2
    
24. Const TH32CS_SNAPthread = &H4
    
25. Const TH32CS_SNAPmodule = &H8
    
26. Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
    
27. 
    
28. 
    
29. '======================在WIN2000下提升本进程权限的API函数常数定义=========== ==========
    
30. Const STANDARD_RIGHTS_REQUIRED = &HF0000
    
31. Const TOKEN_ASSIGN_PRIMARY = &H1
    
32. Const TOKEN_DUPLICATE = (&H2)
    
33. Const TOKEN_IMPERSONATE = (&H4)
    
34. Const TOKEN_QUERY = (&H8)
    
35. Const TOKEN_QUERY_SOURCE = (&H10)
    
36. Const TOKEN_ADJUST_PRIVILEGES = (&H20)
    
37. Const TOKEN_ADJUST_GROUPS = (&H40)
    
38. Const TOKEN_ADJUST_DEFAULT = (&H80)
    
39. Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _
    
40. TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _
    
41. TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
    
42. Const SE_PRIVILEGE_ENABLED = &H2
    
43. Const ANYSIZE_ARRAY = 1
    
44. Private Type LUID
    
45. lowpart As Long
    
46. highpart As Long
    
47. End Type
    
48. Private Type LUID_AND_ATTRIBUTES
    
49. pLuid As LUID
    
50. Attributes As Long
    
51. End Type
    
52. Private Type TOKEN_PRIVILEGES
    
53. PrivilegeCount As Long
    
54. Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
    
55. End Type
    
56. Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
    
57. Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
    
58. Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (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
    
59. Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
    
60. 
    
61. 
    
62. '程序加载
    
63. Private Sub Form_Load()
    
64. AdjustTokenPrivileges2000
    
65. Me.Caption = "WINDOWS 进程管理器"
    
66. Command1.Caption = "刷新"
    
67. Command2.Caption = "终止进程"
    
68. Command3.Caption = "退出"
    
69. ListView1.ColumnHeaders.Clear
    
70. ListView1.ColumnHeaders.Add , "a", "进程ID", 800
    
71. ListView1.ColumnHeaders.Add , "b", "进程名", 4900
    
72. ListView1.View = lvwReport
    
73. Command1_Click '刷新进程列表
    
74. End Sub
    
75. 
    
76. 
    
77. '显示当前系统中全部进程
    
78. Private Sub Command1_Click()
    
79. Dim i As Long, lPid As Long
    
80. Dim Proc As PROCESSENTRY32
    
81. Dim hSnapShot As Long
    
82. ListView1.ListItems.Clear '清空ListView
    
83. hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
    
84. Proc.dwSize = Len(Proc)
    
85. lPid = ProcessFirst(hSnapShot, Proc) '获取第一个进程的PROCESSENTRY32结构信息数据
    
86. i = 0
    
87. Do While lPid <> 0 '当返回值非零时继续获取下一个进程
    
88. ListView1.ListItems.Add , "a" & i, Proc.th32ProcessID & "(&H" & Hex(Proc.th32ProcessID) & ")" '将进程ID添加到ListView1第一列
    
89. ListView1.ListItems("a" & i).SubItems(1) = Proc.szExeFile '将进程名添加到ListView1第二列
    
90. i = i + 1
    
91. lPid = ProcessNext(hSnapShot, Proc) '循环获取下一个进程的PROCESSENTRY32结构信息数据
    
92. Loop
    
93. CloseHandle hSnapShot '关闭进程“快照”句柄
    
94. End Sub
    
95. 
    
96. 
    
97. '终止指定进程
    
98. Private Sub Command2_Click()
    
99. Dim lPHand As Long, TMBack As Long
    
100. If ListView1.SelectedItem.Text <> "" Then
     
101. If MsgBox("确实要结束进程[" & ListView1.SelectedItem.SubItems(1) & "]吗？", vbYesNo) = vbYes Then
     
102. lPHand = Val(ListView1.SelectedItem.Text)
     
103. lPHand = OpenProcess(1&, True, lPHand) '获取进程句柄
     
104. TMBack = TerminateProcess(lPHand, 0&) '关闭进程
     
105. If TMBack <> 0 Then
     
106. MsgBox ListView1.SelectedItem.SubItems(1) & "已经被终止！"
     
107. Else
     
108. MsgBox ListView1.SelectedItem.SubItems(1) & "不能被终止！"
     
109. End If
     
110. CloseHandle lPHand
     
111. Command1_Click '刷新进程列表
     
112. End If
     
113. End If
     
114. End Sub
     
115. 
     
116. 
     
117. '退出本程序
     
118. Private Sub Command3_Click()
     
119. Unload Me
     
120. End Sub
     
121. 
     
122. 
     
123. '这个函数用于在WIN2000系统中，本进程提升权限
     
124. Sub AdjustTokenPrivileges2000()
     
125. Dim hdlProcessHandle As Long
     
126. Dim hdlTokenHandle As Long
     
127. Dim tmpLuid As LUID
     
128. Dim tkp As TOKEN_PRIVILEGES
     
129. Dim tkpNewButIgnored As TOKEN_PRIVILEGES
     
130. Dim lBufferNeeded As Long
     
131. Dim lP As Long
     
132. hdlProcessHandle = GetCurrentProcess()
     
133. lP = OpenProcessToken(hdlProcessHandle, TOKEN_ALL_ACCESS, hdlTokenHandle)
     
134. lP = LookupPrivilegeValue("", "SeDebugPrivilege", tmpLuid)
     
135. tkp.PrivilegeCount = 1
     
136. tkp.Privileges(0).pLuid = tmpLuid
     
137. tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
     
138. lP = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
     
139. End Sub
     
140. 
     
141. 
     

复制代码