VB写的清除IIS缓存
'Alex,2005/08/13Option Explicit
Dim ProcessID() As Long
Dim mTime As String
Dim i As Long
'---------- API类型声明 -----------
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 * 1024
End Type
Private Type MODULEENTRY32 '模块
dwsize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Byte
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 1024
End Type
Private Type THREADENTRY32 '线程
dwsize As Long
cntusage As Long
th32threadID As Long
th32OwnerProcessID As Long
tpBasePri As Long
tpDeltaPri As Long
dwFlags As Long
End Type
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Type LUID
lowpartAs Long
highpartAs Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuidAs LUID
AttributesAs Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCountAs Long
Privileges(ANYSIZE_ARRAY)As LUID_AND_ATTRIBUTES
End Type
'----------------------------------------- API声明 -------------------------------------------------------
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe 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 GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode 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 Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'---------------------------------------- API常数声明 ------------------------------------------------------
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Const PROCESS_TERMINATE = &H1&
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Sub Command1_Click()
Dim Process As PROCESSENTRY32
Dim ProcSnap As Long
Dim cntProcess As Long
cntProcess = 0
ProcSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If ProcSnap Then
Process.dwsize = 1060 ' 通常用法
Process32First ProcSnap, Process
Do Until Process32Next(ProcSnap, Process) < 1 ' 遍历所有进程直到返回值为False
cntProcess = cntProcess + 1
Loop
End If
ReDim ProcessID(cntProcess) As Long
Dim i As Long
i = 0
Process32First ProcSnap, Process
Do Until Process32Next(ProcSnap, Process) < 1 ' 遍历所有进程直到返回值为False
ProcessID(i) = Process.th32ProcessID
If UCase(Left(Process.szExeFile, 12)) = UCase("inetinfo.exe") Then '这里的12 和inetinfo.exe是可变量，根据需要更改."
Call KillProcess(ProcessID(i))
Exit Do
End If
i = i + 1
Loop
CloseHandle (ProcSnap)
End Sub
Public Sub KillProcess(ByVal PID As Long)
Dim hProcess As Long
Dim ExitCode As Long
On Error GoTo Z
If PID > 0 Then
Call AdjustTokenPrivilegesForNT
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
ExitCode = GetExitCodeProcess(hProcess, 0)
If ExitCode <> 0 Then
TerminateProcess hProcess, ExitCode
End If
End If
Exit Sub
Z:
MsgBox "未知错误，请与管理员联系!", vbOKOnly + vbInformation
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
'提升权限
Sub AdjustTokenPrivilegesForNT()
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
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
LookupPrivilegeValue "", "SedebugPrivilege", tmpLuid
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
End Sub
Private Sub Command3_Click()
If InputBox("", "") Then
MsgBox 1
End If
mTime = InputBox("时间以分钟为单位!", "请输入设置时间")
If Val(mTime) < 5 Or Val(mTime) > 100000 Then
MsgBox "请输入一个合理的时间数值!", vbOKOnly + vbInformation
Call Command3_Click
Exit Sub
Else
i = 0
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
i = i + 1
If i = Val(mTime) Then
Call Command1_Click
i = 0
End If
End Sub
页:
[1]