FindFirstUrlCacheEntry Visual Basic 6 API函数

' This project requries a form with a listbox (List1) on it and a class module (MemoryBlock)

' In the form:
Option   Explicit

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
dwReserved 
As   Long
dwExemptDelta 
As   Long
' szRestOfData() As Byte
End  Type

Private   Declare   Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As StringByVal lpFirstCacheEntryInfo As LongByRef lpdwFirstCacheEntryInfoBufferSize As LongAs Long
Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As LongByVal lpNextCacheEntryInfo As LongByRef lpdwNextCacheEntryInfoBufferSize As LongAs Long
Private Declare Sub FindCloseUrlCache Lib "wininet.dll" (ByVal hEnumHandle As Long)
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As StringAs Long

Private Sub Form_Load()
Dim ICEI As INTERNET_CACHE_ENTRY_INFO, Ret As Long
Dim hEntry As Long, Msg As VbMsgBoxResult
Dim MemBlock As New MemoryBlock
'Start enumerating the visited URLs
FindFirstUrlCacheEntry vbNullString, ByVal 0&, Ret
'If Ret is larger than 0...
If Ret > 0 Then
'... allocate a buffer
MemBlock.Allocate Ret
'call FindFirstUrlCacheEntry
hEntry = FindFirstUrlCacheEntry(vbNullString, MemBlock.Handle, Ret)
'copy from the buffer to the INTERNET_CACHE_ENTRY_INFO structure
MemBlock.ReadFrom VarPtr(ICEI), LenB(ICEI)
'Add the lpszSourceUrlName string to the listbox
If ICEI.lpszSourceUrlName <> 0 Then List1.AddItem MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret)
End If
'Loop until there are no more items
Do While hEntry <> 0
'Initialize Ret
Ret = 0
'Find out the required size for the next item
FindNextUrlCacheEntry hEntry, ByVal 0&, Ret
'If we need to allocate a buffer...
If Ret > 0 Then
'... do it
MemBlock.Allocate Ret
'and retrieve the next item
FindNextUrlCacheEntry hEntry, MemBlock.Handle, Ret
'copy from the buffer to the INTERNET_CACHE_ENTRY_INFO structure
MemBlock.ReadFrom VarPtr(ICEI), LenB(ICEI)
'Add the lpszSourceUrlName string to the listbox
If ICEI.lpszSourceUrlName <> 0 Then List1.AddItem MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret)
'Else = no more items
Else
Exit Do
End If
Loop
'Close enumeration handle
FindCloseUrlCache hEntry
'Delete our memory block
Set MemBlock = Nothing
Msg 
= MsgBox("Do you wish to delete the Internet Explorer cache?", vbYesNo + vbDefaultButton2 + vbQuestion)
If Msg = vbYes Then
'loop trough the entries...
For Ret = 0 To List1.ListCount - 1
'...and delete them
DeleteUrlCacheEntry List1.List(Ret)
Next Ret
MsgBox "Cache deleted..."
End If
End Sub



'In the class module 'MemoryBlock':
Option Explicit
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const PAGE_READONLY = &H2
Private Const PAGE_READWRITE = &H4
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_NOCACHE = &H200
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As LongByVal pSrc As LongByVal ByteLen As Long)
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As LongByVal dwSize As LongByVal flAllocationType As LongByVal flProtect As LongAs Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As LongByVal dwSize As LongByVal dwFreeType As LongAs Long
Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As LongByVal dwSize As LongAs Long
Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As LongByVal dwSize As LongAs Long
Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As LongByVal ucb As LongAs Long
Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As LongByVal ucb As LongAs Long
Private Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As LongByVal ucchMax As LongAs Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpStringDest As StringByVal lpStringSrc As LongAs Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongAs Long
Private m_VirtualMem As Long, lLength As Long

'Returns the handle of the allocated memory
Public Property Get Handle() As Long
Handle 
= m_VirtualMem
End Property


'Allocates a specific amount of bytes in the Virtual Memory
Public Sub Allocate(lCount As Long)
ReleaseMemory
m_VirtualMem 
= VirtualAlloc(ByVal 0&, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
VirtualLock m_VirtualMem, lCount
End Sub


'Reads from the allocated memory and writes it to a specified pointer
Public Sub ReadFrom(hWritePointer As Long, lLength As Long)
If IsBadWritePtr(hWritePointer, lLength) = 0 And IsBadReadPtr(Handle, lLength) = 0 Then
CopyMemory hWritePointer, Handle, lLength
End If
End Sub


'Writes to the allocated memory and reads it from a specified pointer
Public Sub WriteTo(hReadPointer As Long, lLength As Long)
If IsBadReadPtr(hReadPointer, lLength) = 0 And IsBadWritePtr(Handle, lLength) = 0 Then
CopyMemory Handle, hReadPointer, lLength
End If
End Sub


'Extracts a string from the allocated memory
Public Function ExtractString(hStartPointer As Long, lMax As LongAs String
Dim Length As Long
If IsBadStringPtr(hStartPointer, lMax) = 0 Then
ExtractString 
= Space(lMax)
lstrcpy ExtractString, hStartPointer
Length 
= lstrlen(hStartPointer)
If Length >= 0 Then ExtractString = Left$(ExtractString, Length)
End If
End Function


'Release the allocated memory
Public Sub ReleaseMemory()
If m_VirtualMem <> 0 Then
VirtualUnlock m_VirtualMem, lLength
VirtualFree m_VirtualMem, lLength, MEM_DECOMMIT
VirtualFree m_VirtualMem, 
0, MEM_RELEASE
m_VirtualMem 
= 0
End If
End Sub


Private Sub Class_Terminate()
ReleaseMemory
End Sub

API Explanation

Begins the enumeration of the Internet cache.

Parameter Information
Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, ByVal lpFirstCacheEntryInfo As Long, ByRef lpdwFirstCacheEntryInfoBufferSize As Long) As Long

· lpszUrlSearchPattern
[in] Pointer to a string that contains the source name pattern to search for. This can be set to "cookie:" or "visited:" to enumerate the cookies and URL History entries in the cache. If this parameter is NULL, the function uses *.*.

· lpFirstCacheEntryInfo
[out] Pointer to an INTERNET_CACHE_ENTRY_INFO structure.

· lpdwFirstCacheEntryInfoBufferSize
[in, out] Pointer to an unsigned long integer variable that specifies the size of the lpFirstCacheEntryInfo buffer, in TCHARs. When the function returns, the variable contains the number of TCHARs copied to the buffer, or the required size, in bytes, needed to retrieve the cache entry.

Returns a handle that the application can use in the FindNextUrlCacheEntry function to retrieve subsequent entries in the cache. If the function fails, the return value is NULL. To get extended error information, call GetLastError.

ERROR_INSUFFICIENT_BUFFER indicates that the size of lpFirstCacheEntryInfo as specified by lpdwFirstCacheEntryInfoBufferSize is not sufficient to contain all the information. The value returned in lpdwFirstCacheEntryInfoBufferSize indicates the buffer size necessary to contain all the information.
 
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值