| 3. |
以下代码粘贴到模块是 form 1：
Option Explicit
Private Declare Function FindFirstUrlCacheGroup Lib "wininet.dll" ( _
ByVal dwFlags As Long, _
ByVal dwFilter As Long, _
ByRef lpSearchCondition As Long, _
ByVal dwSearchCondition As Long, _
ByRef lpGroupId As Date, _
ByRef lpReserved As Long) As Long
Private Declare Function FindNextUrlCacheGroup Lib "wininet.dll" ( _
ByVal hFind As Long, _
ByRef lpGroupId As Date, _
ByRef lpReserved As Long) As Long
Private Declare Function DeleteUrlCacheGroup Lib "wininet.dll" ( _
ByVal sGroupID As Date, _
ByVal dwFlags As Long, _
ByRef lpReserved As Long) As Long
Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" ( _
ByVal lpszUrlSearchPattern As String, _
ByRef lpFirstCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, _
ByRef lpdwFirstCacheEntryInfoBufferSize As Long) As Long
Private Type INTERNET_CACHE_ENTRY_INFO
dwStructSize As Long
szRestOfData(1024) As Long
End Type
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As Long) As Long
Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" ( _
ByVal hEnumHandle As Long, _
ByRef lpNextCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, _
ByRef lpdwNextCacheEntryInfoBufferSize As Long) As Long
Private Const CACHGROUP_SEARCH_ALL = &H0
Private Const ERROR_NO_MORE_FILES = 18
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const CACHEGROUP_FLAG_FLUSHURL_ONDELETE = &H2
Private Const BUFFERSIZE = 2048
Private Sub Command1_Click()
Dim sGroupID As Date
Dim hGroup As Long
Dim hFile As Long
Dim sEntryInfo As INTERNET_CACHE_ENTRY_INFO
Dim iSize As Long
On Error Resume Next
' Delete the groups
hGroup = FindFirstUrlCacheGroup(0, 0, 0, 0, sGroupID, 0)
' To avoid error using it with IE4 as FindFirstUrlCacheGroup is not implemented
If Err.Number <> 453 Then
If (hGroup = 0) And (Err.LastDllError <> 2) Then
MsgBox "An error occurred enumerating the cache groups" & Err.LastDllError
Exit Sub
End If
Else
Err.Clear
End If
If (hGroup <> 0) Then
'we succeeded in finding the first cache group.. enumerate and
'delete
Do
If (0 = DeleteUrlCacheGroup(sGroupID, CACHEGROUP_FLAG_FLUSHURL_ONDELETE, 0)) Then
' To avoid error using it with IE4 as FindFirstUrlCacheGroup is not implemented
If Err.Number <> 453 Then
MsgBox "Error deleting cache group " & Err.LastDllError
Exit Sub
Else
Err.Clear
End If
End If
iSize = BUFFERSIZE
If (0 = FindNextUrlCacheGroup(hGroup, sGroupID, iSize)) And (Err.LastDllError <> 2) Then
MsgBox "Error finding next url cache group! - " & Err.LastDllError
End If
Loop Until Err.LastDllError = 2
End If
' Delete the files
sEntryInfo.dwStructSize = 80
iSize = BUFFERSIZE
hFile = FindFirstUrlCacheEntry(0, sEntryInfo, iSize)
If (hFile = 0) Then
If (Err.LastDllError = ERROR_NO_MORE_ITEMS) Then
GoTo done
End If
MsgBox "ERROR: FindFirstUrlCacheEntry - " & Err.LastDllError
Exit Sub
End If
Do
If (0 = DeleteUrlCacheEntry(sEntryInfo.szRestOfData(0))) _
And (Err.LastDllError <> 2) Then
Err.Clear
End If
iSize = BUFFERSIZE
If (0 = FindNextUrlCacheEntry(hFile, sEntryInfo, iSize)) And (Err.LastDllError <> ERROR_NO_MORE_ITEMS) Then
MsgBox "Error: Unable to find the next cache entry - " & Err.LastDllError
Exit Sub
End If
Loop Until Err.LastDllError = ERROR_NO_MORE_ITEMS
done:
MsgBox "cache cleared"
Command1.Enabled = True
End Sub
|
回到顶端