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?
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, _
lpdwFirstCacheEntryInfoBuf ferSize As Long _
) As Long
Private Declare Function FindNextUrlCacheEntry _
Lib "Wininet.dll" _
Alias "FindNextUrlCacheEntryA" _
(ByVal hEnumHandle As Long, _
lpNextCacheEntryInfo As Any, _
lpdwNextCacheEntryInfoBuff erSize 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(sCache File 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(vbN ullString, 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.lpszSourc eUrlName)
' 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 le, ByVal 0&, lBufferSize)
'Allocate and assign the memory to the pointer
lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
CopyMemory ByVal lptrBuffer, lBufferSize, 4&
Loop While FindNextUrlCacheEntry(lhFi le, 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
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
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
.. Alan
ASKER
Dear Alan,
I try your code but my history still remain.
I use winxp sp2 & IE6sp1
regards,
tu
I try your code but my history still remain.
I use winxp sp2 & IE6sp1
regards,
tu
ASKER
No one can answer my question.
Please delete this question and refund.
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
.. Alan
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\Loc al Settings\History\History.I E5
I want to delete all files and clear all index.dat
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
GPrentice00,
See my previous comment and refer:
https://www.experts-exchange.com/help.jsp#hi54
.. Alan
See my previous comment and refer:
https://www.experts-exchange.com/help.jsp#hi54
.. Alan
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
http://www.freevbcode.com/ShowCode.Asp?ID=5679