clean.bas

这是一款用VB6.0编写的清理IE历史缓存的工具

Attribute VB_Name = "Clean"
Option Explicit

' API函数声明
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Const MF_REMOVE = &H1000&
Public Const SC_CLOSE = &HF060&
Public Const SC_MAXIMIZE = &HF030&
Public Const SC_MINIMIZE = &HF020&

' 常数声明
Public Const WM_SYSCOMMAND = &H112
' 单击控制框产生此消息
Public Const MF_SEPARATOR = &H800&
' 为菜单加一条分隔线
Public Const MF_STRING = &H0&
' 在菜单中加一个字符串
Public Const GWL_WNDPROC = (-4)

' 全局变量
Public OldWindowProc As Long
' 保存默认的窗口函数地址
Public SysMenuHwnd As Long
' 保存系统菜单句柄

Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    If Msg <> WM_SYSCOMMAND Then
        SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
        ' 如果消息不是WM_SYSCOMMAND，就调用默认的窗口函数处理
        Exit Function
    End If

    Select Case wp
        Case 2001
            About.Show vbModal
        Case Else
            SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
            Exit Function
    End Select

    SubClass1_WndMessage = True

End Function