Yo tengo un Cache Deleter.. no se si te sriva.. luego me dices..
Aki tienes el codigo:
1 Label, 1 Textbox y 3 Commands Buttoms.
Private Const ERROR_CACHE_FI ND_FAIL As Long = 0
Private Const ERROR_CACHE_FI ND_SUCCESS As Long = 1
Private Const ERROR_FILE_NOT _FOUND As Long = 2
Private Const ERROR_ACCESS_D ENIED As Long = 5
Private Const ERROR_INSUFFIC IENT_BUFFER As Long = 122
Private Const MAX_PATH As Long = 260
Private Const MAX_CACHE_ENTR Y_INFO_SIZE As Long = 4096
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Private Const LPTR As Long = (LMEM_FIXED Or LMEM_ZEROINIT)
Private Const NORMAL_CACHE_E NTRY As Long = &H1
Private Const EDITED_CACHE_E NTRY As Long = &H8
Private Const TRACK_OFFLINE_ CACHE_ENTRY As Long = &H10
Private Const TRACK_ONLINE_C ACHE_ENTRY As Long = &H20
Private Const STICKY_CACHE_E NTRY As Long = &H40
Private Const SPARSE_CACHE_E NTRY As Long = &H10000
Private Const COOKIE_CACHE_E NTRY As Long = &H100000
Private Const URLHISTORY_CAC HE_ENTRY As Long = &H200000
Private Const URLCACHE_FIND_ DEFAULT_FILTER As Long = NORMAL_CACHE_E NTRY Or _
COOKIE_CACHE_E NTRY Or _
URLHISTORY_CAC HE_ENTRY Or _
TRACK_OFFLINE_ CACHE_ENTRY Or _
TRACK_ONLINE_C ACHE_ENTRY Or _
STICKY_CACHE_E NTRY
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE _ENTRY_INFO
dwStructSize As Long
lpszSourceUrlN ame As Long
lpszLocalFileN ame As Long
CacheEntryType As Long
dwUseCount As Long
dwHitRate As Long
dwSizeLow As Long
dwSizeHigh As Long
LastModifiedTi me As FILETIME
ExpireTime As FILETIME
LastAccessTime As FILETIME
LastSyncTime As FILETIME
lpHeaderInfo As Long
dwHeaderInfoSi ze As Long
lpszFileExtens ion As Long
dwExemptDelta As Long
End Type
Private Declare Function FindFirstUrlCa cheEntry Lib "wininet" _
Alias "FindFirstUrlCa cheEntryA" _
(ByVal lpszUrlSearchP attern As String, _
lpFirstCacheEn tryInfo As Any, _
lpdwFirstCache EntryInfoBuffe rSize As Long) As Long
Private Declare Function FindNextUrlCac heEntry Lib "wininet" _
Alias "FindNextUrlCac heEntryA" _
(ByVal hEnumHandle As Long, _
lpNextCacheEnt ryInfo As Any, _
lpdwNextCacheE ntryInfoBuffer Size As Long) As Long
Private Declare Function FindCloseUrlCa che Lib "wininet" _
(ByVal hEnumHandle As Long) As Long
Private Declare Function DeleteUrlCache Entry Lib "wininet" _
Alias "DeleteUrlCache EntryA" _
(ByVal lpszUrlName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Declare Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(ByVal Ptr As Any) As Long
Private Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Sub Form_Load()
Command1.Capti on = "Get Cache"
Command2.Capti on = "Delete Selected"
Command3.Capti on = "Delete All"
Label1.Caption = ""
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
If Me.Width > 3000 Then
With Command1
.Left = Me.ScaleWidth - .Width - 200
.Top = 200
End With
With Command2
.Left = Command1.Left
.Top = Command1.Top + Command1.Heigh t + 100
End With
With Command3
.Left = Command1.Left
.Top = Command2.Top + Command2.Heigh t + 100
End With
With Label1
.Left = 200
.Top = Me.ScaleHeight - 100 - Label1.Height
End With
With List1
.Left = 200
.Top = 200
.Width = Command1.Left - 300
.Height = (Me.ScaleHeight - 300) - (Me.ScaleHeight - Label1.Top)
End With
End If
End If
End Sub
Private Sub Command1_Click()
With List1
'this speeds up adding to the list
'and eliminates list flicker
.Visible = False
.Clear
Call GetCacheURLLis t
.Visible = True
Label1.Caption = .ListCount & " files listed."
End With
End Sub
Private Sub Command2_Click()
Dim cachefile As String
Dim currindex As Long
Dim currtopindex As Long
'delete the selected file
With List1
'because we're going to reload
'the cache following the deletion,
'be nice and save the current list
'position so it can be restored later
currtopindex = .TopIndex
currindex = .ListIndex
cachefile = .List(currindex)
Call DeleteUrlCache Entry(cachefile)
'reload the list, hiding the list box
'to prevent flicker. (This workaround
'will not provided the desired results
'if a DoEvents is added to the
'GetCacheURLLis t routine!)
.Visible = False
GetCacheURLLis t
.TopIndex = currtopindex
If currindex >= .ListCount Then
.ListIndex = currindex - 1
Else
.ListIndex = currindex
End If
.Visible = True
Label1.Caption = .ListCount & " files listed."
End With
End Sub
Private Sub Command3_Click()
Dim cachefile As String
Dim cnt As Long
With List1
'delete all files
For cnt = 0 To .ListCount - 1
cachefile = .List(cnt)
'if the file is a cookie let's not
'delete it in case it is used to
'store password data.
'
'remove the Instr() test if you want
'to delete cookies as well
If InStr(cachefile, "Cookie") = 0 Then
Call DeleteUrlCache Entry(cachefile)
End If
Next
.Visible = False
GetCacheURLLis t
.ListIndex = -1
.Visible = True
Label1.Caption = .ListCount & " files listed."
End With
End Sub
Private Sub List1_Click()
Command2.Enabl ed = InStr(List1.List(List1.ListInde x), "Cookie") = 0
End Sub
Private Sub GetCacheURLLis t()
Dim icei As INTERNET_CACHE _ENTRY_INFO
Dim hFile As Long
Dim cachefile As String
Dim posUrl As Long
Dim posEnd As Long
Dim dwBuffer As Long
Dim pntrICE As Long
List1.Clear
'Like other APIs, calling FindFirstUrlCa cheEntry or
'FindNextUrlCac heEntry with an buffer of insufficient
'size will cause the API to fail. Call first to
'determine the required buffer size.
hFile = FindFirstUrlCa cheEntry(0&, ByVal 0, dwBuffer)
'both conditions should be met by the first call
If (hFile = ERROR_CACHE_FI ND_FAIL) And _
(Err.LastDllErr or = ERROR_INSUFFIC IENT_BUFFER) Then
'The INTERNET_CACHE _ENTRY_INFO data type
'is a variable-length UDT. It is therefore
'necessary to allocate memory for the result
'of the call and to pass a pointer to this
'memory location to the API.
pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)
'allocation successful
If pntrICE <> 0 Then
'set a Long pointer to the memory location
CopyMemory ByVal pntrICE, dwBuffer, 4
'call FindFirstUrlCa cheEntry again
'now passing the pointer to the
'allocated memory
hFile = FindFirstUrlCa cheEntry(vbNullString, _
ByVal pntrICE, _
dwBuffer)
'hfile should = 1 (success)
If hFile <> ERROR_CACHE_FI ND_FAIL Then
'loop through the cache
Do
'the pointer has been filled, so move the
'data back into a ICEI structure
CopyMemory icei, ByVal pntrICE, Len(icei)
'CacheEntryType is a long representing
'the type of entry returned
If (icei.CacheEntr yType And _
NORMAL_CACHE_E NTRY) = NORMAL_CACHE_E NTRY Then
'extract the string from the memory location
'pointed to by the lpszSourceUrlN ame member
'and add to a list
cachefile = GetStrFromPtrA(icei.lpszSourc eUrlName)
List1.AddItem cachefile
End If
'free the pointer and memory associated
'with the last-retrieved file
Call LocalFree(pntrICE)
'and again by repeating the procedure but
'now calling FindNextUrlCac heEntry. Again,
'the buffer size set to 0 causing the call
'to fail and return the required size as dwBuffer
dwBuffer = 0
Call FindNextUrlCac heEntry(hFile, ByVal 0, dwBuffer)
'allocate and assign the memory to the pointer
pntrICE = LocalAlloc(LMEM_FIXED, dwBuffer)
CopyMemory ByVal pntrICE, dwBuffer, 4
'and call again with the valid parameters.
'If the call fails (no more data), the loop exits.
'If the call is successful, the Do portion of the
'loop is executed again, extracting the data from
'the returned type
Loop While FindNextUrlCac heEntry(hFile, ByVal pntrICE, dwBuffer)
End If 'hFile
End If 'pntrICE
End If 'hFile
'clean up by closing the find handle,
'as well as calling LocalFree again
'to be safe
Call LocalFree(pntrICE)
Call FindCloseUrlCa che(hFile)
End Sub
Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Salu2
Autor