'<a href="/tag/daima/" target="_blank" class="keywords">代码</a>: Option Explicit '======================用于查找进程和终止进程的API<a href="/tag/hanshu/" target="_blank" class="keywords">函数</a>常数定义================ ===== 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 Const MAX_PATH As Integer = 260 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 Const TH32CS_SNAPheaplist = &H1 Const TH32CS_SNAPPROCESS = &H2 Const TH32CS_SNAPthread = &H4 Const TH32CS_SNAPmodule = &H8 Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule '======================在WIN2000下提升本进程权限的API<a href="/tag/hanshu/" target="_blank" class="keywords">函数</a>常数定义=========== ========== Const STANDARD_RIGHTS_<a href="/tag/required/" target="_blank" class="keywords">required</a> = &HF0000 Const TOKEN_ASSIGN_PRIMARY = &H1 Const TOKEN_DUPLICATE = (&H2) Const TOKEN_IMPERSONATE = (&H4) Const TOKEN_QUERY = (&H8) Const TOKEN_QUERY_SOURCE = (&H10) Const TOKEN_ADJUST_PRIVILEGES = (&H20) Const TOKEN_ADJUST_GROUPS = (&H40) Const TOKEN_ADJUST_DEFAULT = (&H80) Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_<a href="/tag/required/" target="_blank" class="keywords">required</a> Or TOKEN_ASSIGN_PRIMARY Or _ TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _ TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT) Const SE_PRIVILEGE_ENABLED = &H2 Const ANYSIZE_ARRAY = 1 Private Type LUID lowpart As Long highpart As Long End Type Private Type LUID_AND_ATTRIBUTES pLuid As LUID Attributes As Long End Type Private Type TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES End Type Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String,ByVal lpName As String,lpLuid As LUID) As Long Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long,ByVal DisableAllPrivileges As Long,NewState As TOKEN_PRIVILEGES,ByVal BufferLength As Long,Prev<a href="/tag/IoU/" target="_blank" class="keywords">IoU</a>sState As TOKEN_PRIVILEGES,ReturnLength As Long) As Long Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long,ByVal DesiredAccess As Long,TokenHandle As Long) As Long Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String,ByVal dwFileAttributes As Long) As Long Dim i As Long,lPid As Long Dim Proc As PROCESSENTRY32 Dim hSnapShot As Long Dim lPHand As Long,TMBack As Long Private Sub Command1_Click() On Error GoTo errha If ListView1.Visible = True Then If ListView1.SelectedItem.Text <> "" Then lPHand = Val(ListView1.SelectedItem.Text) lPHand = OpenProcess(1&,True,lPHand) '<a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>进程句柄 TMBack = TerminateProcess(lPHand,0&) '<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>进程 If TMBack <> 0 Then Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> ListView1.SelectedItem.SubItems(1) & "已经被终止！" Else Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> ListView1.SelectedItem.SubItems(1) & "不能被终止！" End If CloseHandle lPHand End If End If If Text1.Text <> "" Then Fensuiwenjian End If Exit Sub errha: Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> "unknow error!!!",vbInformation,"<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>刪除" End Sub Private Sub Command2_Click() C1.ShowOpen If C1.FileName <> "" Then Text1.Text = C1.FileName Label2.Caption = FileLen(Text1.Text) & " Bytes" End If End Sub Private Sub KillProcess(ByVal strProcess As String) Dim strComputer As String Dim objWMIService As Object Dim colProcessList Dim objProcess As Object On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2") Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & strProcess & "'") For Each objProcess In colProcessList objProcess.Terminate Next End Sub Private Sub Command3_Click() If Command3.Caption = "无进程操作" Then ListView1.Visible = False Command3.Caption = "有进程操作" Else ListView1.Visible = True Command3.Caption = "无进程操作" End If End Sub Private Sub Command4_Click() ListView1.ListItems.Clear '清空ListView hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall,0) '获得进程“快照”的句柄 Proc.dwSize = Len(Proc) lPid = ProcessFirst(hSnapShot,Proc) '<a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>第一个进程的PROCESSENTRY32结构信息数据 i = 0 Do While lPid <> 0 '当返回值非零时继续<a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>下一个进程 ListView1.ListItems.Add,"a" & i,Proc.th32ProcessID & "(&H" & Hex(Proc.th32ProcessID) & ")" '将进程ID<a href="/tag/tianjia/" target="_blank" class="keywords">添加</a>到ListView1第一列 ListView1.ListItems("a" & i).SubItems(1) = Proc.szExeFile '将进程名<a href="/tag/tianjia/" target="_blank" class="keywords">添加</a>到ListView1第二列 i = i + 1 lPid = ProcessNext(hSnapShot,Proc) '循环<a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>下一个进程的PROCESSENTRY32结构信息数据 Loop CloseHandle hSnapShot '<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>进程“快照”句柄 End Sub Private Sub Command5_Click() If Command5.Caption = "<a href="/tag/zidong/" target="_blank" class="keywords">自动</a>刷新进程" Then Timer1.Enabled = True Command5.Caption = "取消<a href="/tag/zidong/" target="_blank" class="keywords">自动</a>刷新" Else Timer1.Enabled = False Command5.Caption = "<a href="/tag/zidong/" target="_blank" class="keywords">自动</a>刷新进程" End If End Sub Private Sub Form_Load() AdjustTokenPrivileges2000 ListView1.ColumnHeaders.Clear ListView1.ColumnHeaders.Add,"a","进程ID",800 ListView1.ColumnHeaders.Add,"b","进程名",4900 ListView1.View = lvwReport End Sub Private Sub Fensuiwenjian() Dim buff() As Byte ProgressBar1.Visible = True Dim filelong As Long ProgressBar1.Min = 0 Open Text1.Text For Binary Access Read Write As #1 ReDim buff(1 To 2560) filelong = LOF(1) ProgressBar1.Max = filelong ProgressBar1.Value = 0 Do While Not EOF(1) Get #1,buff For i = 1 To 2560 buff(i) = 255 'Debug.Print "buff" & i & "=" & buff(i) Next i For i = 1 To filelong Step 2560 Put #1,i,buff ProgressBar1.Value = i Next i Loop Close #1 Dim fso As New FileSystemObject fso.DeleteFile Text1.Text,True Text1.Text = "" Msg<a href="/tag/Box/" target="_blank" class="keywords">Box</a> "<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a><a href="/tag/shanchu/" target="_blank" class="keywords">删除</a>成功！",vbOKOnly ProgressBar1.Visible = False End Sub '这个<a href="/tag/hanshu/" target="_blank" class="keywords">函数</a>用于在WIN2000系统中，本进程提升权限 Sub AdjustTokenPrivileges2000() Dim hdlProcessHandle As Long Dim hdlTokenHandle As Long Dim tmpLuid As LUID Dim tkp As TOKEN_PRIVILEGES Dim tkpNewButIgnored As TOKEN_PRIVILEGES Dim lBufferNeeded As Long Dim lP As Long hdlProcessHandle = GetCurrentProcess() lP = OpenProcessToken(hdlProcessHandle,TOKEN_ALL_ACCESS,hdlTokenHandle) lP = LookupPrivilegeValue("","SeDebugPrivilege",tmpLuid) tkp.PrivilegeCount = 1 tkp.Privileges(0).pLuid = tmpLuid tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED lP = AdjustTokenPrivileges(hdlTokenHandle,False,tkp,Len(tkpNewButIgnored),tkpNewButIgnored,lBufferNeeded) End Sub Private Sub Timer1_Timer() ListView1.ListItems.Clear '清空ListView hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall,Proc) '循环<a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>下一个进程的PROCESSENTRY32结构信息数据 Loop CloseHandle hSnapShot '<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>进程“快照”句柄 End Sub

http://hi.baidu.com/yzidan/blog/item/f313bdf314328453352acca8.html