Keskustelu: Ohjelmointikysymykset: VBA: WebBrowserin sivun tyhjentäminen

Imports System
Imports System.Runtime.InteropServices

Public Class DeleteCache

'FindFirstURLCacheEntry-funktiolla voi etsiä ensimmäisen välimuistimerkinnän
'FindNextUrlCacheEntry-fuktiolla voi rullata läpi koko välimuistiluettelon
'DeleteUrlCacheEntry-funktiolla voi poistaa välimuistiluettelosta merkinnän

	<StructLayout(LayoutKind.Explicit, Size := 80)> _
	Public Structure INTERNET_CACHE_ENTRY_INFOA
		<FieldOffset(0)> _
		Public dwStructSize As UInteger
		<FieldOffset(4)> _
		Public lpszSourceUrlName As IntPtr
		<FieldOffset(8)> _
		Public lpszLocalFileName As IntPtr
		<FieldOffset(12)> _
		Public CacheEntryType As UInteger
		<FieldOffset(16)> _
		Public dwUseCount As UInteger
		<FieldOffset(20)> _
		Public dwHitRate As UInteger
		<FieldOffset(24)> _
		Public dwSizeLow As UInteger
		<FieldOffset(28)> _
		Public dwSizeHigh As UInteger
		<FieldOffset(32)> _
		Public LastModifiedTime As _
		System.Runtime.InteropServices.ComTypes.FILETIME
		<FieldOffset(40)> _
		Public ExpireTime As _
		System.Runtime.InteropServices.ComTypes.FILETIME
		<FieldOffset(48)> _
		Public LastAccessTime As _
		System.Runtime.InteropServices.ComTypes.FILETIME
		<FieldOffset(56)> _
		Public LastSyncTime As _
		System.Runtime.InteropServices.ComTypes.FILETIME
		<FieldOffset(64)> _
		Public lpHeaderInfo As IntPtr
		<FieldOffset(68)> _
		Public dwHeaderInfoSize As UInteger
		<FieldOffset(72)> _
		Public lpszFileExtension As IntPtr
		<FieldOffset(76)> _
		Public dwReserved As UInteger
		<FieldOffset(76)> _
		Public dwExemptDelta As UInteger
	End Structure


	<DllImport("wininet", SetLastError := True, CharSet := CharSet.Auto, EntryPoint := "FindFirstUrlCacheGroup", CallingConvention := CallingConvention.StdCall)> _
	Public Shared Function FindFirstUrlCacheGroup(dwFlags As Integer, dwFilter As Integer, lpSearchCondition As IntPtr, dwSearchCondition As Integer, ByRef lpGroupId As Long, lpReserved As IntPtr) As IntPtr
	End Function

	<DllImport("wininet", SetLastError := True, CharSet := CharSet.Auto, EntryPoint := "FindNextUrlCacheGroup", CallingConvention := CallingConvention.StdCall)> _
	Public Shared Function FindNextUrlCacheGroup(hFind As IntPtr, ByRef lpGroupId As Long, lpReserved As IntPtr) As Boolean
	End Function

	<DllImport("wininet", SetLastError := True, CharSet := CharSet.Auto, EntryPoint := "DeleteUrlCacheGroup", CallingConvention := CallingConvention.StdCall)> _
	Public Shared Function DeleteUrlCacheGroup(GroupId As Long, dwFlags As Integer, lpReserved As IntPtr) As Boolean
	End Function

	<DllImport("wininet", SetLastError := True, CharSet := CharSet.Auto, EntryPoint := "FindFirstUrlCacheEntryA", CallingConvention := CallingConvention.StdCall)> _
	Public Shared Function FindFirstUrlCacheEntry(<MarshalAs(UnmanagedType.LPTStr)> lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As IntPtr, ByRef lpdwFirstCacheEntryInfoBufferSize As Integer) As IntPtr
	End Function

	<DllImport("wininet", SetLastError := True, CharSet := CharSet.Auto, EntryPoint := "FindNextUrlCacheEntryA", CallingConvention := CallingConvention.StdCall)> _
	Public Shared Function FindNextUrlCacheEntry(hFind As IntPtr, lpNextCacheEntryInfo As IntPtr, ByRef lpdwNextCacheEntryInfoBufferSize As Integer) As Boolean
	End Function

	<DllImport("wininet", SetLastError := True, CharSet := CharSet.Auto, EntryPoint := "DeleteUrlCacheEntryA", CallingConvention := CallingConvention.StdCall)> _
	Public Shared Function DeleteUrlCacheEntry(lpszUrlName As IntPtr) As Boolean
	End Function

	<STAThread> _
	Private Shared Sub Main(args As String())

		Const  CACHEGROUP_SEARCH_ALL As Integer = &H0
		Const  CACHEGROUP_FLAG_FLUSHURL_ONDELETE As Integer = &H2
		Const  ERROR_FILE_NOT_FOUND As Integer = &H2
		Const  ERROR_NO_MORE_ITEMS As Integer = 259
		Dim groupId As Long = 0

		Dim cacheEntryInfoBufferSizeInitial As Integer = 0
		Dim cacheEntryInfoBufferSize As Integer = 0
		Dim cacheEntryInfoBuffer As IntPtr = IntPtr.Zero
		Dim internetCacheEntry As INTERNET_CACHE_ENTRY_INFOA
		Dim enumHandle As IntPtr = IntPtr.Zero
		Dim returnValue As Boolean = False

		enumHandle = FindFirstUrlCacheGroup(0, CACHEGROUP_SEARCH_ALL, IntPtr.Zero, 0, groupId, IntPtr.Zero)

		If enumHandle <> IntPtr.Zero AndAlso ERROR_NO_MORE_ITEMS = Marshal.GetLastWin32Error() Then
		Return
		End If

		While True
		returnValue = DeleteUrlCacheGroup(groupId, CACHEGROUP_FLAG_FLUSHURL_ONDELETE, IntPtr.Zero)
		If Not returnValue AndAlso ERROR_FILE_NOT_FOUND = Marshal.GetLastWin32Error() Then
			returnValue = FindNextUrlCacheGroup(enumHandle, groupId, IntPtr.Zero)
		End If

		If Not returnValue AndAlso (ERROR_NO_MORE_ITEMS = Marshal.GetLastWin32Error() OrElse ERROR_FILE_NOT_FOUND = Marshal.GetLastWin32Error()) Then
			Exit While
		End If
		End While
		enumHandle = FindFirstUrlCacheEntry(Nothing, IntPtr.Zero, cacheEntryInfoBufferSizeInitial)
		If enumHandle = IntPtr.Zero AndAlso ERROR_NO_MORE_ITEMS = Marshal.GetLastWin32Error() Then
		Return
		End If

		cacheEntryInfoBufferSize = cacheEntryInfoBufferSizeInitial
		cacheEntryInfoBuffer = Marshal.AllocHGlobal(cacheEntryInfoBufferSize)
		enumHandle = FindFirstUrlCacheEntry(Nothing, cacheEntryInfoBuffer, cacheEntryInfoBufferSizeInitial)

		While True
		internetCacheEntry = CType(Marshal.PtrToStructure(cacheEntryInfoBuffer, GetType(INTERNET_CACHE_ENTRY_INFOA)), INTERNET_CACHE_ENTRY_INFOA)

		cacheEntryInfoBufferSizeInitial = cacheEntryInfoBufferSize
		returnValue = DeleteUrlCacheEntry(internetCacheEntry.lpszSourceUrlName)
		If Not returnValue Then
			returnValue = FindNextUrlCacheEntry(enumHandle, cacheEntryInfoBuffer, cacheEntryInfoBufferSizeInitial)
		End If
		If Not returnValue AndAlso ERROR_NO_MORE_ITEMS = Marshal.GetLastWin32Error() Then
			Exit While
		End If
		If Not returnValue AndAlso cacheEntryInfoBufferSizeInitial > cacheEntryInfoBufferSize Then
			cacheEntryInfoBufferSize = cacheEntryInfoBufferSizeInitial
			cacheEntryInfoBuffer = Marshal.ReAllocHGlobal(cacheEntryInfoBuffer, CType(cacheEntryInfoBufferSize, IntPtr))
			returnValue = FindNextUrlCacheEntry(enumHandle, cacheEntryInfoBuffer, cacheEntryInfoBufferSizeInitial)
		End If
		End While
		Marshal.FreeHGlobal(cacheEntryInfoBuffer)
	End Sub

End Class