VB清除ＩＥ缓存

在窗体里放一个command控件，然后点击，就可以清除了： 

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