Option Explicit

Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40

Private Type FILETIME
    lLowDateTime As Long
    lHighDateTime As Long
End Type

Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type

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
   LastModifiedTime As FILETIME
   ExpireTime As FILETIME
   LastAccessTime As FILETIME
   LastSyncTime As FILETIME
   lpHeaderInfo As Long
   dwHeaderInfoSize As Long
   lpszFileExtension As Long
   dwExemptDelta As Long
End Type

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 Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoA" ( _
        ByVal lpszUrlName As String, _
        ByVal lpCacheInfo As Long, _
        lpdwCacheEntryInfoBufferSize As Long) As Long

Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String) As Long
    
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) 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
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 hEnumHandle As Long
Private ci As INTERNET_CACHE_ENTRY_INFO
Private lPtrCI As Long

Public Property Get CachedEntryCacheType() As Long
    CachedEntryCacheType = ci.CacheEntryType
End Property

Public Property Get CachedEntryExpireTime() As Date
On Local Error Resume Next
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.ExpireTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryExpireTime = dExpire
End Property

Public Property Get CachedEntryFileExtension() As String
Dim strData As String
Dim lReturnValue As Long
Dim iPosition As Long
    strData = Space(250)
    lReturnValue = PtrToStr(strData, ci.lpszFileExtension)
    If lReturnValue Then
        iPosition = InStr(strData, Chr(0))
        CachedEntryFileExtension = Left$(strData, iPosition - 1)
    End If
End Property

Public Property Get CachedEntryLastAccessTime() As Date
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.LastAccessTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryLastAccessTime = dExpire
End Property

Public Property Get CachedEntryLastModifiedTime() As Date
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.LastModifiedTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryLastModifiedTime = dExpire
End Property

Public Property Get CachedEntryLastSyncTime() As Date
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.LastSyncTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryLastSyncTime = dExpire
End Property

Public Property Get 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 Property

Public Property Get 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 Property

Public Function DeleteCacheEntry(SourceUrl As String) As Boolean
Dim lReturnValue As Long
    lReturnValue = DeleteUrlCacheEntry(SourceUrl)
    DeleteCacheEntry = CBool(lReturnValue)
End Function

Public Function FindEntryInCache(Url As String) As Boolean
Dim lReturnValue As Long, lSizeOfStruct As Long
    lReturnValue = GetUrlCacheEntryInfo(Url, 0&, lSizeOfStruct)
    If lPtrCI Then LocalFree lPtrCI
    lPtrCI = LocalAlloc(LMEM_FIXED, lSizeOfStruct)
    If lPtrCI Then
        CopyMemory ByVal lPtrCI, lSizeOfStruct, 4
        lReturnValue = GetUrlCacheEntryInfo(Url, lPtrCI, lSizeOfStruct)
        CopyMemory ci, ByVal lPtrCI, Len(ci)
        LocalFree lPtrCI
    End If
    FindEntryInCache = CBool(lReturnValue)
End Function

Public Function FindFirstCacheEntry() As Boolean
Dim lSizeOfStruct As Long
    If hEnumHandle <> 0 Then FindCloseUrlCache hEnumHandle
    hEnumHandle = FindFirstUrlCacheEntry(vbNullString, 0&, lSizeOfStruct)
    If lPtrCI Then LocalFree lPtrCI
    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
        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 Function

Private Sub Class_Terminate()
    If hEnumHandle Then Call FindCloseUrlCache(hEnumHandle)
End Sub