Visual Basic Internet Routines

CoCreateInstance: Delete the IE History Cache
     
Posted:   Monday April 25, 2005
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   Windows ME or later, Windows 2000 or later
Author:   VBnet - Randy Birch, activevb.de
     

Related:  

FindFirstUrlCacheEntry: Obtain the Contents of the IE Cache
FindFirstUrlCacheEntry: Delete the IE Cache
CoCreateInstance: Delete the IE History Cache
     
 Prerequisites
Internet Explorer 3 or later. Note this is only deletes the IE history - it will not work against the history recorded by other browsers.

This code is very loosely based on a German demo from www.activevb.de that will delete all entries in the Internet Explorer history prior to the current day (e.g. it will not delete the entries under "Today". If you run this with the IE history displayed, a quirk with IE will result in the code appearing to delete all the entries. But if you click the history column and press F5, or re-select a View option, the history for Today will reappear.

The code is modified from the activevb.de site to correctly utilize a GUID rather than a string, as is the convention with the CLSIDFromString API.

Also, note that this code does not delete any information from the hidden index.dat history-tracking files used by all versions of Internet Explorer and Windows ... your history of sites visited still remained logged there.

 BAS Module Code
None.

 Form Code
To a form, add a command button (Command1) and a label (Label1). Add the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const CLSID_CUrlHistory = "{3C374A40-BAE4-11CF-BF7D-00AA006946EE}"
Private Const CLSID_IUrlHistoryStg2 = "{AFA0DC11-C313-11D0-831A-00C04FD5AE38}"
Private Const IUrlHistoryStg2_Release As Long = 8&
Private Const IUrlHistoryStg2_ClearHistory As Long = 36&
Private Const CLSCTX_INPROC_SERVER As Long = 1&
Private Const CC_STDCALL As Long = 4&
Private Const S_OK As Long = 0&

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

'rclsid: [in] CLSID associated with the data and
'   code that will be used to create the object (GUID).
'pUnkOuter: [in] If NULL, indicates that the object
'   is not being created as part of an aggregate.
'   If non-NULL, pointer to the aggregate object's
'   IUnknown interface (the controlling IUnknown).
'dwClsContext: [in] Context in which the code that
'   manages the newly created object will run. The
'   values are taken from the enumeration CLSCTX.
'riid: [in] Reference to the identifier of the
'   interface to be used to communicate with the object (GUID).
'pvarResult: [out] Address of pointer variable that receives
'   the interface pointer requested in riid. Upon
'   successful return, *pvarResult contains the requested
'   interface pointer. Upon failure, *pvarResult contains NULL.
Private Declare Function CoCreateInstance Lib "ole32" _
  (rclsid As Any, _
   ByVal pUnkOuter As Long, _
   ByVal dwClsContext As Long, _
   riid As Any, _
   pvarResult As Long) As Long
   
   
'pvInstance: Pointer to an instance of the
'   interface described by this type description
'   here returned by CoCreateInstance as pvarResult.
'oVft: For FUNC_VIRTUAL functions, specifies
'   the offset in the VTBL.
'cc: The calling convention. One of the CALLCONV
'   values, such as CC_STDCALL.
'vtReturn: The variant type of the function return
'   value. DispCallFunc uses VT_EMPTY to represent void.
'cActuals: The number of function parameters.
'prgvt: An array of variant types of the function parameters.
'prgpvarg: The function parameters.
'pvargResult: The function result.
Private Declare Function DispCallFunc Lib "oleaut32" _
  (ByVal pvarResult As Long, _
   ByVal oVft As Long, _
   ByVal cc As Long, _
   ByVal vtReturn As VbVarType, _
   ByVal nParams As Long, _
   pVarTypes As Long, _
   pVarArgs As Long, _
   pvarResult As Variant) As Long
   
Private Declare Function CLSIDFromString Lib "ole32" _
  (ByVal lpszGuid As Long, _
   pGuid As Any) As Long




Private Sub Form_Load()

   Command1.Caption = "Delete IE History"
   Label1.Caption = ""
   
End Sub


Private Sub Command1_Click()
    
   If DeleteHistory() Then
      Label1.Caption = "History has been deleted!"
   End If
    
End Sub


Private Function DeleteHistory() As Boolean

   Dim objClsid As GUID
   Dim idClsid As GUID
   Dim pvarResult  As Long
   Dim ret As Long
   
  'create a GUID from each CLSID string
   Call CLSIDFromString(StrPtr(CLSID_CUrlHistory), objClsid)
   Call CLSIDFromString(StrPtr(CLSID_IUrlHistoryStg2), idClsid)
    
  'obtain an interface pointer for idClsid
   If CoCreateInstance(objClsid, 0&, _
                       CLSCTX_INPROC_SERVER, _
                       idClsid, _
                       pvarResult) = S_OK Then
   
     'DispCallFunc is a low-level helper for
     'IDispatch::Invoke() that provides
     'machine independence for customized Invoke().
     '
     'oVft specifies the value of a virtual
     'function offdet in the VTBL (IUrlHistoryStg2_ClearHistory
     'and IUrlHistoryStg2_Release).
     '
     'ret will = 0 for the first call, and 1 for
     'the second call if successful (these are
     'not required in this demo). The return value
     'representing success for each call is 0 (S_OK).
      If DispCallFunc(pvarResult, _
                      IUrlHistoryStg2_ClearHistory, _
                      CC_STDCALL, _
                      vbLong, 0&, 0&, 0&, ret) = S_OK Then
      
         If DispCallFunc(pvarResult, _
                         IUrlHistoryStg2_Release, _
                         CC_STDCALL, _
                         vbLong, 0&, 0&, 0&, ret) = S_OK Then
         
            DeleteHistory = True
         
         End If  'DispCallFunc/2
      End If  'DispCallFunc/1
   End If  'CoCreateInstance
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter