Visual Basic Classic
--
Questions
--
Followers
Top Experts
Zero AI Policy
We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.
I had a problem with users on terminal services allowing IE caches to get very large. I wrote this program (clearcache) to get around it.
Save the following as clearcache.frm, add it to a project, and compile it.
.. Alan
____________________SNIP__
VERSION 5.00
Begin VB.Form F_ClearCache
  Caption     =  "ClearCache"
  ClientHeight   =  1845
  ClientLeft    =  60
  ClientTop    =  345
  ClientWidth   =  3885
  ControlBox    =  0  'False
  LinkTopic    =  "Form1"
  ScaleHeight   =  1845
  ScaleWidth    =  3885
  StartUpPosition =  3  'Windows Default
  Begin VB.TextBox Total
   BeginProperty DataFormat
     Type       =  1
     Format      =  "0"
     HaveTrueFalseNull=  0
     FirstDayOfWeek  =  0
     FirstWeekOfYear =  0
     LCID       =  2057
     SubFormatType  =  1
   EndProperty
   Height      =  285
   Left       =  2265
   TabIndex     =  7
   Top       =  1035
   Width      =  1140
  End
  Begin VB.CheckBox C_Hist
   Caption     =  "Clear History"
   Height      =  285
   Left       =  210
   TabIndex     =  6
   Top       =  660
   Width      =  1605
  End
  Begin VB.CheckBox C_Cookies
   Caption     =  "Clear Cookies"
   Height      =  285
   Left       =  210
   TabIndex     =  5
   Top       =  375
   Width      =  1605
  End
  Begin VB.CheckBox C_Temp
   Caption     =  "Clear Temporary Files"
   Height      =  285
   Left       =  210
   TabIndex     =  4
   Top       =  90
   Width      =  1950
  End
  Begin VB.TextBox T_Hist
   BeginProperty DataFormat
     Type       =  1
     Format      =  "0"
     HaveTrueFalseNull=  0
     FirstDayOfWeek  =  0
     FirstWeekOfYear =  0
     LCID       =  2057
     SubFormatType  =  1
   EndProperty
   Height      =  285
   Left       =  2265
   TabIndex     =  3
   Top       =  660
   Width      =  1140
  End
  Begin VB.TextBox T_Cookies
   BeginProperty DataFormat
     Type       =  1
     Format      =  "0"
     HaveTrueFalseNull=  0
     FirstDayOfWeek  =  0
     FirstWeekOfYear =  0
     LCID       =  2057
     SubFormatType  =  1
   EndProperty
   Height      =  285
   Left       =  2265
   TabIndex     =  2
   Top       =  375
   Width      =  1140
  End
  Begin VB.TextBox T_Temp
   BeginProperty DataFormat
     Type       =  1
     Format      =  "0"
     HaveTrueFalseNull=  0
     FirstDayOfWeek  =  0
     FirstWeekOfYear =  0
     LCID       =  2057
     SubFormatType  =  1
   EndProperty
   Height      =  285
   Left       =  2265
   TabIndex     =  1
   Top       =  90
   Width      =  1140
  End
  Begin VB.CommandButton Command1
   Caption     =  "Go"
   Height      =  345
   Left       =  1530
   TabIndex     =  0
   Top       =  1455
   Width      =  855
  End
  Begin VB.Label Label1
   Alignment    =  1  'Right Justify
   Caption     =  "Total:"
   Height      =  240
   Left       =  1185
   TabIndex     =  8
   Top       =  1057
   Width      =  870
  End
End
Attribute VB_Name = "F_ClearCache"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Compare Text
'-------------------------
Private Const ERROR_CACHE_FIND_FAIL As Long = 0
Private Const ERROR_CACHE_FIND_SUCCESS As Long = 1
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Public Enum eCacheType
  enormal = &H1&
  eEdited = &H8&
  eTrackOffline = &H10&
  eTrackOnline = &H20&
  eSticky = &H40&
  eSparse = &H10000
  ecookie = &H100000
  eURLHistory = &H200000
  eURLFindDefaultFilter = 0&
  eCacheAllFiles = &HFFFFFF
End Enum
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     'Type of entry returned
  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 lpszUrlSearchPattern As String, _
             lpFirstCacheEntryInfo As Any, _
             lpdwFirstCacheEntryInfoBuf
          ) As Long
        Â
Private Declare Function FindNextUrlCacheEntry _
           Lib "Wininet.dll" _
          Alias "FindNextUrlCacheEntryA" _
          (ByVal hEnumHandle As Long, _
             lpNextCacheEntryInfo As Any, _
             lpdwNextCacheEntryInfoBuff
          ) As Long
         Â
Private Declare Function FindCloseUrlCache _
           Lib "Wininet.dll" _
          (ByVal hEnumHandle As Long _
          ) As Long
Private Declare Function DeleteUrlCacheEntry _
           Lib "Wininet.dll" _
          Alias "DeleteUrlCacheEntryA" _
          (ByVal lpszUrlName As String _
          ) 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 Sub CopyMemory _
        Lib "kernel32" _
       Alias "RtlMoveMemory" _
       (pDest As Any, _
           pSource As Any, _
        ByVal dwLength 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
     Â
Dim bView As Boolean
Dim bTemp As Boolean
Dim bHist As Boolean
Dim bCookies As Boolean
Dim ANumEntries As Long
Dim TNumEntries As Long
Dim CNumEntries As Long
Dim HNumEntries As Long
'Purpose   :  Deletes the specified internet cache file
'Inputs    :  sCacheFile        The name of the cache file
'Outputs   :  Returns True on success.
'Author    :  Andrew Baker
'Date     :  03/08/2000 19:14
'Notes    :
'Revisions  :
Function InternetDeleteCache(sCache
  InternetDeleteCache = CBool(DeleteUrlCacheEntry(
End Function
'Purpose   :  Returns an array of files stored in the internet cache
'Inputs    :  eFilterType       An enum which filters the files returned by their type
'Outputs   :  A one dimensional, one based, string array containing the names of the files
'Author    :  Andrew Baker
'Date     :  03/08/2000 19:14
'Notes    :
'Revisions  :
Sub InternetCacheList(bDelete As Boolean)
  Dim ICEI As INTERNET_CACHE_ENTRY_INFO
  Dim lhFile As Long, lBufferSize As Long, lptrBuffer As Long
  Dim sCacheFile As String
  'Determine required buffer size
  lBufferSize = 0
  lhFile = FindFirstUrlCacheEntry(0&,
 Â
  If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER)
 Â
    'Allocate memory for ICEI structure
    lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
 Â
    If lptrBuffer Then
    Â
      'Set a Long pointer to the memory location
      CopyMemory ByVal lptrBuffer, lBufferSize, 4
     Â
      'Call first find API passing it the pointer to the allocated memory
      lhFile = FindFirstUrlCacheEntry(vbN
     Â
      If lhFile <> ERROR_CACHE_FIND_FAIL Then
     Â
        'Loop through the cache
        Do
          'Copy data back to structure
          CopyMemory ICEI, ByVal lptrBuffer, Len(ICEI)
          ' and add to the all file count if first pass
          If Not bDelete Then ANumEntries = ANumEntries + 1
          If bDelete Then sCacheFile = StrFromPtrA(ICEI.lpszSourc
          ' is it a url history?
          If ICEI.CacheEntryType And eURLHistory Then
            If Not bDelete Then HNumEntries = HNumEntries + 1
            If bDelete And bHist Then
              InternetDeleteCache sCacheFile
              HNumEntries = HNumEntries - 1
            End If
            If Me.Visible Then T_Hist.Text = CStr(HNumEntries)
           ' or a cookie?
          ElseIf ICEI.CacheEntryType And ecookie Then
            If Not bDelete Then CNumEntries = CNumEntries + 1
            If bDelete And bCookies Then
              InternetDeleteCache sCacheFile
              CNumEntries = CNumEntries - 1
            End If
            If Me.Visible Then T_Cookies.Text = CStr(CNumEntries)
          Else
            If Not bDelete Then TNumEntries = TNumEntries + 1
            If bDelete And bTemp Then
              InternetDeleteCache sCacheFile
              TNumEntries = TNumEntries - 1
            End If
            If Me.Visible Then T_Temp.Text = CStr(TNumEntries)
          End If
       Â
          If Me.Visible Then Total.Text = CStr(TNumEntries + CNumEntries + HNumEntries)
          Me.Refresh
          'Free memory associated with the last-retrieved file
          Call LocalFree(lptrBuffer)
         Â
          'Call FindNextUrlCacheEntry with buffer size set to 0.
          'Call will fail and return required buffer size.
          lBufferSize = 0
          Call FindNextUrlCacheEntry(lhFi
         Â
          'Allocate and assign the memory to the pointer
          lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
          CopyMemory ByVal lptrBuffer, lBufferSize, 4&
       Â
        Loop While FindNextUrlCacheEntry(lhFi
     Â
      End If
   Â
    End If
 Â
  End If
 Â
  'Free memory
  Call LocalFree(lptrBuffer)
  Call FindCloseUrlCache(lhFile)
End Sub
'Purpose   :  Converts a pointer to an ansi string into a string.
'Inputs    :  lptrString          A long pointer to a string held in memory
'Outputs   :  The string held at the specified memory address
'Author    :  Andrew Baker
'Date     :  03/08/2000 19:14
'Notes    :
'Revisions  :
Function StrFromPtrA(ByVal lptrString As Long) As String
  'Create buffer
  StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0)
  'Copy memory
  Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString)
End Function
Private Sub Command1_Click()
  If Command1.Caption = "Go" Then
  Me.Caption = "Please Wait - Clearing your Internet Cache"
    bHist = C_Hist.Value = vbChecked
    bTemp = C_Temp.Value = vbChecked
    bCookies = C_Cookies.Value = vbChecked
    T_Temp.Text = ""
    T_Cookies.Text = ""
    T_Hist.Text = ""
    Total.Text = ""
    Me.Refresh
    InternetCacheList True
    MsgBox "Done clearing cache - " & CStr(ANumEntries - CLng(Total.Text)) & " entries deleted"
  End If
  Unload Me
End Sub
Private Sub Form_Load()
  Dim hadslash As Boolean
  Dim i As Integer, j As Integer
  If Command = "" Then
    InternetCacheList False
    T_Temp.Text = CStr(TNumEntries)
    T_Cookies.Text = CStr(CNumEntries)
    T_Hist.Text = CStr(HNumEntries)
    Total.Text = CStr(TNumEntries + CNumEntries + HNumEntries)
    Me.Visible = True
    Exit Sub
  End If
  Me.Visible = False
  ' Command can be any combination of:
  ' /t - Temporary files
  ' /c - Cookies
  ' /h - History
  ' OR /a - all
  ' and /v - visible interface
  ' As in 'c' may be /c/t/h or /c /t /h or /cth
  j = 0
  For i = 1 To Len(Command)
    Select Case Mid(Command, i, 1)
    Case "/"
      hadslash = True
    Case "a"
      If hadslash Then
        If Not bTemp Then
          bTemp = True
        Else
          j = 0
          Exit For
        End If
        If Not bCookies Then
          bCookies = True
        Else
          bCookies = False
          j = 0
          Exit For
        End If
        If Not bHist Then
          bHist = True
        Else
          bHist = False
          j = 0
          Exit For
        End If
        j = j + 1
      End If
    Case "t"
       If hadslash Then
        If Not bTemp Then
          bTemp = True
        Else
          j = 0
          Exit For
        End If
        j = j + 1
      End If
    Case "c"
        If Not bCookies Then
          bCookies = True
        Else
          bCookies = False
          j = 0
          Exit For
        End If
        j = j + 1
    Case "h"
        If Not bHist Then
          bHist = True
        Else
          bHist = False
          j = 0
          Exit For
        End If
        j = j + 1
    Case "v"
        If Not bView Then
          bView = True
        Else
          bView = False
          j = 0
          Exit For
        End If
        j = j + 1
    Case " ", ","
      hadslash = False
    Case Else
      j = 0
    End Select
  Next
  If j > 0 And j < 5 Then
    If bView Then
      If bCookies Or bHist Or bTemp Then
        C_Temp.Value = vbUnchecked
        C_Hist.Value = vbUnchecked
        C_Cookies.Value = vbUnchecked
        If bTemp Then C_Temp.Value = vbChecked
        If bHist Then C_Hist.Value = vbChecked
        If bCookies Then C_Cookies.Value = vbChecked
      End If
      InternetCacheList False
      C_Temp.Enabled = False
      C_Hist.Enabled = False
      C_Cookies.Enabled = False
      Command1.Visible = False
      T_Temp.Text = CStr(TNumEntries)
      T_Cookies.Text = CStr(CNumEntries)
      T_Hist.Text = CStr(HNumEntries)
      Total.Text = CStr(TNumEntries + CNumEntries + HNumEntries)
      Me.Caption = "Please Wait - Clearing your Internet Cache"
      Me.Visible = True
    Else
      Me.Visible = False
    End If
    InternetCacheList True
    Unload Me
    Exit Sub
  End If
  ' Invalid Command line
  If j = 0 Or j > 4 Then
    MsgBox "Invalid Command line " & Command & vbCrLf & _
        "Should be:" & vbCrLf & _
        "/t (Temporary files)" & vbCrLf & _
        "/c (Cookies)" & vbCrLf & _
        "/h (History URLs)" & vbCrLf & _
        "Or:" & vbCrLf & _
        "/a (All cache entries)" & vbCrLf & _
        "/v (Visible interface)" & vbCrLf & _
        "Multiple switches may be combined viz:" & vbCrLf & _
        "/tc or /ch (/tch = /a)", vbCritical
    Unload Me
  End If
End Sub






EARN REWARDS FOR ASKING, ANSWERING, AND MORE.
Earn free swag for participating on the platform.
.. Alan
I try your code but my history still remain.
I use winxp sp2 &Â IE6sp1
regards,
tu
Please delete this question and refund.

Get a FREE t-shirt when you ask your first question.
We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.
.. Alan
I use your code but when I reopen my IE6 sp1,and click history button I still see history links.
your code delete cache only.
Tu.
ps. i want program about privacy,not only clear disk space. if it does not clear all,it have no value to me.
example of folder to keep IE6 history :
C:\Documents and Settings\administrator\Loc
I want to delete all files and clear all index.dat
See my previous comment and refer:
https://www.experts-exchange.com/help.jsp#hi54
.. Alan






EARN REWARDS FOR ASKING, ANSWERING, AND MORE.
Earn free swag for participating on the platform.
Visual Basic Classic
--
Questions
--
Followers
Top Experts
Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.