VB写的清除IIS缓存

jxh1230

　　'Alex,2005/08/13
　　Option 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
       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

　　'----------------------------------------- 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