Link to home
Start Free TrialLog in
Avatar of groone
groone

asked on

Clearing History and Temp Inet directories

The kill statement doesnt clear the temporary internet directory nor does it clear the history directory.  How would I accomplish clearing these folders?

ASKER CERTIFIED SOLUTION
Avatar of AzraSound
AzraSound
Flag of United States of America image

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
Avatar of Ark
Hi
'--Bas module code----
*************
' Removing IE Temporary Files
'***************************************' Author: Eduardo Morcillo
' E-Mail: edanmo@geocities.com
' Web Page: http://www.domaindlx.com/e_morcillo
'
Option Explicit

Type UUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Public Const CLSCTX_INPROC_SERVER = 1
Declare Function CoCreateInstance Lib "ole32" (rclsid As UUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, riid As UUID, ppv As Object) As Long

Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpOLEStr As Long, pclsid As UUID) As Long

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_ALL_ACCESS = &HF003F

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Public Const CSIDL_INTERNET_CACHE = &H20&

Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long

'Form code
'Place command button cmdClean and Label1 at your form

Option Explicit

' Implement IEmptyVolumeCacheCallBack to
' receive messages from the cleaner
Implements IEmptyVolumeCacheCallBack

' CLSIDs and IIDs used by this program
Const CLSID_TemporaryCleaner = "{9B0EFD60-F7B0-11D0-BAEF-00C04FC308C9}"
Const CLSID_OffLineCleaner = "{8E6E6079-0CB7-11D2-8F10-0000F87ABD16}"
Const IID_IEmptyVolumeCache = "{8FCE5227-04DA-11d1-A004-00805F8ABE06}" & vbNullChar

' Registry keys used by the cleaners
Const HKEY_OFFLINE = "Software\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Offline Pages Files"
Const HKEY_TEMPORARY = "Software\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Internet Cache Files"

Dim TemporaryFiles As IEmptyVolumeCache
Dim OffLinePages As IEmptyVolumeCache

Dim Size As Currency

'*********************************************************************************************
' CreateCleaner
'
' Creates a cleaner object from its CLSID
'*********************************************************************************************
Private Function CreateCleaner(ByVal GUID As String) As IEmptyVolumeCache
Dim CLSID As UUID, IID As UUID

    ' Convert the strings to
    ' GUID structs
    CLSIDFromString StrPtr(GUID), CLSID
    CLSIDFromString StrPtr(IID_IEmptyVolumeCache), IID

    ' Instantiate the handler
     CoCreateInstance CLSID, 0&, CLSCTX_INPROC_SERVER, IID, CreateCleaner
   
End Function

'*********************************************************************************************
' Removes the files
'*********************************************************************************************
Private Sub cmdClean_Click()

    OffLinePages.Purge Size / 10000, Me
    TemporaryFiles.Purge Size / 10000, Me
   
    Unload Me
   
End Sub

'*********************************************************************************************
' InitializeCleaners
'
' Initializes the cleaner objects
'*********************************************************************************************
Private Sub InitializeCleaners()
Dim hKey As Long, Drive As String, PIDL As Long
Dim Name As Long, Desc As Long, Flags As Long
   
    ' Get the Temporary Files path
    Drive = Space$(260)
   
    SHGetSpecialFolderLocation Me.hWnd, CSIDL_INTERNET_CACHE, PIDL
    SHGetPathFromIDList PIDL, Drive
   
    Drive = Left$(Drive, 3)
   
    CoTaskMemFree PIDL
   
    ' Open the OffLine pages registry key
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, HKEY_OFFLINE, 0&, KEY_ALL_ACCESS, hKey) = 0 Then
   
        ' Initialize the OffLine pages cleaner
        OffLinePages.Initialize hKey, Drive, Name, Desc, Flags
       
        ' Free unused memory
        CoTaskMemFree Name
        CoTaskMemFree Desc
       
        ' Close the key
        RegCloseKey hKey
       
    End If

    ' Open the TemporaryFiles registry key
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, HKEY_TEMPORARY, 0&, KEY_ALL_ACCESS, hKey) = 0 Then
   
        ' Initialize the OffLine pages cleaner
        TemporaryFiles.Initialize hKey, Drive, Name, Desc, Flags
       
        ' Free unused memory
        CoTaskMemFree Name
        CoTaskMemFree Desc
       
        ' Close the key
        RegCloseKey hKey
       
    End If

End Sub

Private Sub Form_Load()
Dim Size1 As Currency

    ' Create the cleaner objects
    Set OffLinePages = CreateCleaner(CLSID_OffLineCleaner)
    Set TemporaryFiles = CreateCleaner(CLSID_TemporaryCleaner)
   
    ' Initialize the cleaners
    InitializeCleaners

    ' Get the space used by the files
    TemporaryFiles.GetSpaceUsed Size1, Me
    Size = Size1 * 10000
   
    OffLinePages.GetSpaceUsed Size1, Me
    Size = Size + (Size1 * 10000)
   
    ' Show the space in the form
    lblInfo.Caption = "The Temporary Internet Files are using " & Format(Size / 1024 / 1024, "00.00") & " Mb on the drive. Press Clean button to remove them."
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim Flags As Long

    ' Destroy the objects
   
    OffLinePages.Deactivate Flags
    TemporaryFiles.Deactivate Flags
   
    Set OffLinePages = Nothing
    Set TemporaryFiles = Nothing
   
End Sub

Private Sub IEmptyVolumeCacheCallBack_PurgeProgress(ByVal dwlSpaceFreed As Currency, ByVal dwlSpaceToFree As Currency, ByVal dwFlags As IEVC.IEmptyVolumeCacheCallBackFlags, ByVal pcwszStatus As Long)
'
End Sub

Private Sub IEmptyVolumeCacheCallBack_ScanProgress(ByVal dwlSpaceUsed As Currency, ByVal dwFlags As IEVC.IEmptyVolumeCacheCallBackFlags, ByVal pcwszStatus As Long)
'
End Sub

Cheers