Attribute VB_Name = "Cache"
Option Explicit
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Private Type INTERNET_CACHE_ENTRY_INFO
   dwStructSize As Long
   lpszSourceUrlName As Long
   lpszLocalFileName As Long
   CacheEntryType As Long
   dwUseCount As Long
   dwHitRate As Long
   dwSizeLow As Long
   dwSizeHigh As Long
   lpHeaderInfo As Long
   dwHeaderInfoSize As Long
   lpszFileExtension As Long
   dwExemptDelta As Long
End Type
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String) As Long
        
Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" ( _
        ByVal lpszSearchPattern As String, _
        ByVal lpCacheInfo As Long, _
        lpdwFirstCacheEntryInfoBufferSize As Long) As Long
    
Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" ( _
        ByVal hEnumHandle As Long, _
        ByVal lpCacheInfo As Long, _
        lpdwNextCacheEntryInfoBufferSize As Long) As Long

Private Declare Function FindCloseUrlCache Lib "wininet.dll" ( _
        ByVal hEnumHandle As Long) As Long
        
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        pDest As Any, _
        pSource As Any, _
        ByVal dwLength 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

Public Declare Function lstrcpyA Lib "kernel32" ( _
        ByVal RetVal As String, ByVal Ptr As Long) As Long
                        
Public Declare Function lstrlenA Lib "kernel32" ( _
        ByVal Ptr As Any) As Long
  
Private hEnumHandle As Long
Private ci As INTERNET_CACHE_ENTRY_INFO
Private lPtrCI As Long

Public Function CachedEntryCacheType() As Long
    CachedEntryCacheType = ci.CacheEntryType
End Function
Public Function CachedEntryFileName() As String
    Dim strData As String
    Dim lReturnValue As Long
    Dim iPosition As Long
    strData = String$(lstrlenA(ByVal ci.lpszLocalFileName), 0)
    lReturnValue = lstrcpyA(strData, ci.lpszLocalFileName)
    If lReturnValue Then
        CachedEntryFileName = strData
    End If
End Function
Public Function CachedEntrySourceURL() As String
    Dim strData As String
    Dim lReturnValue As Long
    Dim iPosition As Long
    strData = String$(lstrlenA(ci.lpszSourceUrlName), 0)
    lReturnValue = lstrcpyA(strData, ci.lpszSourceUrlName)
    If lReturnValue Then
        CachedEntrySourceURL = strData
    End If
End Function

Public Function FindFirstCacheEntry() As Boolean
    Dim lSizeOfStruct As Long
    
    If hEnumHandle <> 0 Then
        FindCloseUrlCache hEnumHandle
    End If
    hEnumHandle = FindFirstUrlCacheEntry(vbNullString, 0&, lSizeOfStruct)
    
    If lPtrCI Then
        LocalFree lPtrCI
    End If

    lPtrCI = LocalAlloc(LMEM_FIXED, lSizeOfStruct)
    If lPtrCI Then
        CopyMemory ByVal lPtrCI, lSizeOfStruct, 4
        hEnumHandle = FindFirstUrlCacheEntry(ByVal vbNullString, lPtrCI, lSizeOfStruct)
        CopyMemory ci, ByVal lPtrCI, Len(ci)
    End If
    
    FindFirstCacheEntry = CBool(hEnumHandle)
End Function

Public Function FindNextCacheEntry() As Boolean
    Dim lReturnValue As Long, lSizeOfStruct As Long
    
    If hEnumHandle <> 0 Then
        lReturnValue = FindNextUrlCacheEntry(hEnumHandle, 0&, lSizeOfStruct)
        If lPtrCI Then
            LocalFree lPtrCI
        End If
        lPtrCI = LocalAlloc(LMEM_FIXED, lSizeOfStruct)
        If lPtrCI Then
            CopyMemory ByVal lPtrCI, lSizeOfStruct, 4
            lReturnValue = FindNextUrlCacheEntry(hEnumHandle, lPtrCI, lSizeOfStruct)
            CopyMemory ci, ByVal lPtrCI, Len(ci)
        End If

        If lReturnValue <> 0 Then
            FindNextCacheEntry = CBool(lReturnValue)
        End If
    End If
End Function
Public Function DeleteCacheEntry(SourceUrl As String) As Boolean
    Dim lReturnValue As Long
    
    lReturnValue = DeleteUrlCacheEntry(SourceUrl)
    DeleteCacheEntry = CBool(lReturnValue)
    
End Function
Public Sub ReleaseCache()
    If hEnumHandle Then
        Call FindCloseUrlCache(hEnumHandle)
    End If
End Sub