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