[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 870
  • Last Modified:

VB6 API, How do I use GetCacheEntryInfo to fill a INTERNET_CACHE_ENTRY_INFO structure?

Dear Experts,

I have this sample which I've been trying to modify. Originally what this example apparently did was take an url that pointed to an internet cached entry and said whether or not it existed. However, the implementation of this was simply to pass GetCacheEntryInfo the url and nothing for the structure argument whatsoever, knowing this would result in an error. But if it was the ERROR_INSUFFICIENT_BUFFER error that was returned then the entry must exist.

But I want the actual entry itself. I want to fill the structure describing it and know everything about the temporary file that the entry is about. Ultimately I want the pathname to the file that is in the temporary internet files that the url I give it actually points to. But I still want to know everything the entry can tell me, for learning and understanding, and who knows what else may come in handy? :)

So.. the whole question is, based on the following code, how would I actually successfully fill the INTERNET_CACHE_ENTRY_INFO structure using GetCacheEntryInfo?

From what I've gathered by looking at other examples it seems like I need to pass a pointer to the structure I want filled, or I need to obtain the buffer size of the entry I want to read and then use copymemory to actually put the info into the structure.. Ideally, I would just like to know the right way to use GetCacheEntryInfo because if I'm not mistaken that is actually what the function is supposed to do, but who knows..?

Thanks immensely! ~Jeffrey

P.S. Umm.. hopefully VB Classic is the right category for vb6 and the Win OS Dev is the right category for Windows API calls. Got me.. it'd be kinda cool if the categories had short descriptions so you could know what they really are..
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const eeErrorBase = 26720

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
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

'This is the function that returns the info about the cached file
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" _
    Alias "GetUrlCacheEntryInfoA" (ByVal sUrlName As String, _
    lpCacheEntryInfo As Any, lpdwCacheEntryInfoBufferSize As Long) As Long

' To Report API errors:
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
    Arguments As Long) As Long

Public Function GetCacheEntryInfo(ByVal hWnd As Long, ByVal lpszUrl As String) As Boolean
    Dim dwEntrySize As Long, dwTemp As Long, lErr As Long
    Dim lpCacheEntry As INTERNET_CACHE_ENTRY_INFO

    'If (GetUrlCacheEntryInfo(lpszUrl, ByVal 0&, dwEntrySize)) = 0 Then
    If (GetUrlCacheEntryInfo(lpszUrl, VarPtr(lpCacheEntry), dwEntrySize)) = 0 Then
        Stop
        lErr = Err.LastDllError
        If (lErr <> ERROR_INSUFFICIENT_BUFFER) Then
            ' Doesn't exist. Raise error containing reason:
            Err.Raise eeErrorBase + 1, App.EXEName & ".mCacheEntry", WinAPIError(lErr)
            GetCacheEntryInfo = False
            Exit Function
        Else
            ' It exists!
            Stop
            GetCacheEntryInfo = True
        End If
    End If
End Function

Public Function WinAPIError(ByVal lLastDLLError As Long) As String
    ' Return the error message associated with LastDLLError:
    Dim sBuff As String, lCount As Long
    sBuff = String$(256, 0)
    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
        0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then WinAPIError = Trim(Left$(sBuff, lCount))
End Function

Open in new window

0
JeffreyDurham
Asked:
JeffreyDurham
  • 5
  • 3
1 Solution
 
JeffreyDurhamAuthor Commented:
Dear Experts,

I am making progress on this, and think I've even almost got it working, but I was still wondering if you guys could look at my code, and make sure I didn't make any mistakes that will lead to bad use of memory or crash the computer (this seems to happen when I mess with API without really knowing exactly what I'm doing.. :)

Also now that I've got the structure filled, I'm having trouble getting the file name from the structure.. It is giving me results like:
the filename is: r
or it is: x

I think I'm not using the GetStrFromPtrA correctly or the lstrlenA/lstrcpyA properly.. I'm hoping that the two properties actually contain more than those values..

Thanks! ~Jeffrey
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const eeErrorBase = 26720

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
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

'This is the function that returns the info about the cached file
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" _
    Alias "GetUrlCacheEntryInfoA" (ByVal sUrlName As String, _
    lpCacheEntryInfo As Any, lpdwCacheEntryInfoBufferSize As Long) As Long

'Allocates Certain Amount of Memory in Bytes
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long

'Releases Memory
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

'Copies Memory
Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
        
'Used to translate strings from api string pointers to strings we can use
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
        
' To Report API errors:
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
    Arguments As Long) As Long

Public Function GetCacheEntryInfo(ByVal hWnd As Long, ByVal lpszUrl As String) As String
    Dim dwEntrySize As Long, dwTemp As Long, lErr As Long
    Dim CacheEntry As INTERNET_CACHE_ENTRY_INFO
    
    If (GetUrlCacheEntryInfo(lpszUrl, ByVal 0&, dwEntrySize)) = 0 Then
        
        lErr = Err.LastDllError
        If (lErr <> ERROR_INSUFFICIENT_BUFFER) Then
            ' Doesn't exist. Raise error containing reason:
            Err.Raise eeErrorBase + 1, App.EXEName & ".mCacheEntry", WinAPIError(lErr)
            Exit Function
        Else
            'It Exists, now fill structure with info about it
            
            'Create Pointer for filling Cache Entry
            Dim ptrCacheEntry As Long
            ptrCacheEntry = LocalAlloc(LMEM_FIXED, dwEntrySize)
            'Fill CacheEntry structure with data from Memory Location
            CopyMemory CacheEntry, ByVal ptrCacheEntry, Len(CacheEntry)
            
            'Get Pathname to Temporary Internet File
            GetCacheEntryInfo = GetStrFromPtrA(CacheEntry.lpszLocalFileName)
            Debug.Print GetStrFromPtrA(CacheEntry.lpszLocalFileName)
            Debug.Print GetStrFromPtrA(CacheEntry.lpszSourceUrlName)
            Stop
            
            'Free the memory for last accessed entry
            Call LocalFree(ptrCacheEntry)
        End If
    End If
End Function

'SUPPORING FUNCS

Public Function WinAPIError(ByVal lLastDLLError As Long) As String
    ' Return the error message associated with LastDLLError:
    Dim sBuff As String, lCount As Long
    sBuff = String$(256, 0)
    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
        0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then WinAPIError = Trim(Left$(sBuff, lCount))
End Function

Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Open in new window

0
 
JeffreyDurhamAuthor Commented:
Ok I think I've determined that I'm just copying random memory into the structure, and the values in it are not the right values at all ):

So, anybody see what I'm doing wrong?
Thanks! ~Jeffrey
0
 
nffvrxqgrcfqvvcCommented:
Jeffrey your close but after you make the first call to allocate the buffer you need to make a second call and pass the pointer to allocated buffer so that it can fill in the buffer with the information.
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
nffvrxqgrcfqvvcCommented:
Here is the unicode verison jeffery.

Option Explicit

Private Const HEAP_ZERO_MEMORY = &H8&

Private Type FILETIME
  dwLowDateTime         As Long
  dwHighDateTime        As Long
End Type

Private Type INTERNET_CACHE_ENTRY_INFOW '(Unicode)
  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
  '     union {
  '    DWORD dwReserved;
  '    DWORD dwExemptDelta;
  '  } ;
End Type

Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Private Declare Function GetUrlCacheEntryInfoW Lib "wininet.dll" (ByVal lpszUrlName As Long, ByVal lpCacheEntryInfo As Long, ByRef lpcbCacheEntryInfo As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal ptr As Long) As Long

Private Function WidePointerString(ByVal lpPointer As Long) As String
' Helper function
Dim Buffer() As Byte
Dim lpSize As Long
lpSize = lstrlenW(lpPointer) * 2
  If lpSize <> 0 Then
    ReDim Buffer(lpSize) As Byte
    RtlMoveMemory Buffer(0), ByVal lpPointer, lpSize
    WidePointerString = Buffer
  End If
Erase Buffer
End Function

Public Sub GetCacheEntryW(ByVal szUrl As String)
  
  ' GetCacheEntryW (Unicode) version by egl1044

  Dim ic        As INTERNET_CACHE_ENTRY_INFOW
  Dim Buffer    As Long ' buffer
  Dim cb        As Long ' size
  
  ' obtain the required buffer size.
  Call GetUrlCacheEntryInfoW(StrPtr(szUrl), 0, cb)
  
  ' allocate the buffer
  If cb <> 0 Then
    Buffer = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, cb)
  Else
    Debug.Print Err.LastDllError
    Exit Sub ' _leave
  End If

  ' obtain the cache information
  If GetUrlCacheEntryInfoW(StrPtr(szUrl), Buffer, cb) Then
    ' copy the buffer to the structure to easily manage
    ' the pointers.
    RtlMoveMemory ic, ByVal Buffer, LenB(ic)
    Debug.Print WidePointerString(ic.lpszSourceUrlName)
    Debug.Print WidePointerString(ic.lpszLocalFileName)
  Else
    Debug.Print Err.LastDllError
  End If
  
  ' free memory
  HeapFree GetProcessHeap, 0, Buffer
  Buffer = 0
  
End Sub

Private Sub Form_Load()

  GetCacheEntryW "http://www.experts-exchange.com/xp/images/newZone.gif"
  
End Sub

Open in new window

0
 
JeffreyDurhamAuthor Commented:
egl1044:

Excellent, I will try this right away. :)
Is there a different version for pictures? Will this work the same for actual web pages, pdfs, and jpgs?

Michael
0
 
JeffreyDurhamAuthor Commented:
Egl1044!

It works perfectly! That is exactly what I wanted. Thank you very much! I like the way the structure is filled too, it doesn't crash the program. Very nice. :) I'll be sure to always include your name in the module the way you have it. Thanks again!

~Jeffrey
(Sorry people, I know on the previous comment I put Michael, but that is because it is my middle name and is also awesome :P)
0
 
JeffreyDurhamAuthor Commented:
It was the best example to do this that I've seen anywhere, and I have searched for one. Yes, it works perfectly. I'd recommend this solution to any other people that have the same desire, that is extracting files from the temporary internet folder instead of downloading them (which is so pointless since they already are!).. Good Job Egl1044!
0
 
nffvrxqgrcfqvvcCommented:
Your welcome Jeffrey and thank you for your feedback :)
0

Featured Post

Learn to develop an Android App

Want to increase your earning potential in 2018? Pad your resume with app building experience. Learn how with this hands-on course.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now