通过IEmptyVolumeCacheCallBack接口清理IE缓存的类

       (声明：魏滔序原创，转贴请注明出处。)
        在IE缓存目录中积累着很多的文件， 这些文件虽然可以提高浏览旧网页的速度，但是对磁盘空间的占用也与时俱进。对于爱“干净”的人，总觉得有点得不偿失。下面就贴出清理缓存的源码，清理缓存的方法有很多，这里介绍的是通过IEmptyVolumeCacheCallBack接口实现的例子。

新建工程，引用 olelib.tlb (可以从http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip下载)
建一个类，名称：IETempClear
粘贴如下源码：

 Option Explicit
Implements IEmptyVolumeCacheCallBack

Private Const IID_IEmptyVolumeCache = "{8FCE5227-04DA-11d1-A004-00805F8ABE06}"
Private Const CLSID_TemporaryCleaner = "{9B0EFD60-F7B0-11D0-BAEF-00C04FC308C9}"    '临时文件
Private Const CLSID_OffLineCleaner = "{8E6E6079-0CB7-11D2-8F10-0000F87ABD16}"    '脱机文件

Private TemporaryFiles As IEmptyVolumeCache                '临时文件
Private OffLinePages As IEmptyVolumeCache                  '脱机文件

Private Const HKEY_OFFLINE_PAGES = "Software/Microsoft/Windows/CurrentVersion/Explorer/VolumeCaches/Offline Pages Files"
Private Const HKEY_TEMPORARY = "Software/Microsoft/Windows/CurrentVersion/Explorer/VolumeCaches/Internet Cache Files"
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private mSize As Currency

Property Get SpaceSize() As Long
    SpaceSize = mSize
End Property

'根据GUID实例化清理器对象
Private Function CreateCleaner(ByVal GUID As String) As IEmptyVolumeCache
    Dim CLSID As UUID, IID As UUID
    Dim Unknown As IUnknown

    CLSIDFromString GUID, CLSID
    CLSIDFromString IID_IEmptyVolumeCache & vbNullChar, IID
    CoCreateInstance CLSID, Unknown, CLSCTX_INPROC_SERVER, IID, CreateCleaner
End Function

Public Sub StarClear()
    OffLinePages.Purge mSize / 10000, Me
    TemporaryFiles.Purge mSize / 10000, Me
End Sub

' 初始化清理器对象
Private Sub InitializeCleaners()
    Dim Name As Long, Desc As Long, Flags As Long
    Dim hKey As Long, Drive As String, PIDL As Long

    '获得临时文件所在驱动器
    Drive = Space$(260)
    PIDL = SHGetSpecialFolderLocation(0, CSIDL_INTERNET_CACHE)
    SHGetPathFromIDList PIDL, Drive
    Drive = Left$(Drive, 3)

    CoTaskMemFree PIDL

    '脱机
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, HKEY_OFFLINE_PAGES, 0&, KEY_ALL_ACCESS, hKey) = 0 Then
        OffLinePages.Initialize hKey, Drive, Name, Desc, Flags
        CoTaskMemFree Name
        CoTaskMemFree Desc
        RegCloseKey hKey
    End If

    '临时
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, HKEY_TEMPORARY, 0&, KEY_ALL_ACCESS, hKey) = 0 Then
        TemporaryFiles.Initialize hKey, Drive, Name, Desc, Flags
        CoTaskMemFree Name
        CoTaskMemFree Desc
        RegCloseKey hKey
    End If
End Sub

Private Sub Class_Initialize()
    Dim Size As Currency

    Set OffLinePages = CreateCleaner(CLSID_OffLineCleaner)
    Set TemporaryFiles = CreateCleaner(CLSID_TemporaryCleaner)

    Call InitializeCleaners

    TemporaryFiles.GetSpaceUsed Size, Me
    mSize = Size * 10000

    OffLinePages.GetSpaceUsed Size, Me
    mSize = mSize + (Size * 10000)
End Sub

Private Sub Class_Terminate()
    Dim Flags As Long

    OffLinePages.Deactivate Flags
    TemporaryFiles.Deactivate Flags

    Set OffLinePages = Nothing
    Set TemporaryFiles = Nothing
End Sub

Private Sub IEmptyVolumeCacheCallBack_PurgeProgress(ByVal dwlSpaceFreed As Currency, ByVal dwlSpaceToFree As Currency, ByVal dwFlags As olelib.IEmptyVolumeCacheCallBackFlags, ByVal pcwszStatus As Long)
    '
End Sub

Private Sub IEmptyVolumeCacheCallBack_ScanProgress(ByVal dwlSpaceUsed As Currency, ByVal dwFlags As olelib.IEmptyVolumeCacheCallBackFlags, ByVal pcwszStatus As Long)
    '
End Sub

使用方法：
Private Sub Command1_Click()
    Dim IEClear As New IETempClear
    MsgBox "IE缓存占用空间： " & IEClear.SpaceSize & " 字节。"
    IEClear.StarClear
    Set IEClear = Nothing
End Sub