Link to home
Start Free TrialLog in
Avatar of tutemp
tutemp

asked on

How to coding vb6 to act like click button "Delete Cookies..","Delete Files.." & " Clear History" in Internet Options.. in IE6?

How to coding vb6 to act like click button "Delete Cookies..","Delete Files.." & " Clear History" in Internet Options.. in IE6?
Avatar of bsncs02
bsncs02

Take a look at this example:

http://www.freevbcode.com/ShowCode.Asp?ID=5679
Hi,
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
'--------------------------Types, consts and structures
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

'--------------------------Internet Cache API
Private Declare Function FindFirstUrlCacheEntry _
                     Lib "Wininet.dll" _
                   Alias "FindFirstUrlCacheEntryA" _
                   (ByVal lpszUrlSearchPattern As String, _
                          lpFirstCacheEntryInfo As Any, _
                          lpdwFirstCacheEntryInfoBufferSize As Long _
                   ) As Long
                 
Private Declare Function FindNextUrlCacheEntry _
                     Lib "Wininet.dll" _
                   Alias "FindNextUrlCacheEntryA" _
                   (ByVal hEnumHandle As Long, _
                          lpNextCacheEntryInfo As Any, _
                          lpdwNextCacheEntryInfoBufferSize As Long _
                   ) 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

'--------------------------Memory API
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(sCacheFile As String) As Boolean
    InternetDeleteCache = CBool(DeleteUrlCacheEntry(sCacheFile))
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&, ByVal 0&, lBufferSize)
   
    If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
   
        '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(vbNullString, ByVal lptrBuffer, lBufferSize)        '1 = success
           
            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.lpszSourceUrlName)
                    ' 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(lhFile, ByVal 0&, lBufferSize)
                   
                    'Allocate and assign the memory to the pointer
                    lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
                    CopyMemory ByVal lptrBuffer, lBufferSize, 4&
               
                Loop While FindNextUrlCacheEntry(lhFile, ByVal lptrBuffer, lBufferSize)
           
            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
Avatar of tutemp

ASKER

thanks all , but the solutions can clear contents in "index.dat" ?
Yes, providing the cookies option is set (/c on the command line, clea cookies checkbox in gui mode).

.. Alan
Avatar of tutemp

ASKER

Dear Alan,
I try your code but my history still remain.
I use winxp sp2 & IE6sp1
regards,
tu
Avatar of tutemp

ASKER

No one can answer my question.
Please delete this question and refund.
Delete files, delete cookies are both covered in the code above. Certain history is also deleted. Why not all history is deleted I'm at a loss to know, as the above code is based on MS published API. I do not agree with a delete and refund, as the question is at least partialy answered, and in fact as fully answered as the published APIs allow.

.. Alan
Avatar of tutemp

ASKER

Dear 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\Local Settings\History\History.IE5
I want to delete all files and clear all index.dat
GPrentice00,
See my previous comment and refer:
https://www.experts-exchange.com/help.jsp#hi54

.. Alan
ASKER CERTIFIED SOLUTION
Avatar of modulo
modulo

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial