千万次的问:如何有效删除IE7历史记录?
http://www.applevb.com/sourcecode/delete%20history.zip
这个代码在IE6环境下能删除单个或全部记录,非常好用!
但在IE7环境下则无法删除带中文的记录,请高手出手看看为什么?如何解决?谢谢
[解决办法]
Const CLSID_CUrlHistory = "{3C374A40-BAE4-11CF-BF7D-00AA006946EE} "
Const CLSID_IUrlHistoryStg2 = "{AFA0DC11-C313-11D0-831A-00C04FD5AE38} "
Const IUrlHistoryStg2_Release As Long = 8&
Const IUrlHistoryStg2_ClearHistory As Long = 36&
Const CLSCTX_INPROC_SERVER As Long = 1&
Const CC_STDCALL As Long = 4&
Const S_OK As Long = 0&
Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Declare Function CoCreateInstance Lib "ole32 " (rclsid As Any, ByVal pUnkOuter As Long, _
ByVal dwClsContext As Long, riid As Any, pvarResult As Long) As Long
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
Declare Function CLSIDFromString Lib "ole32 " (ByVal lpszGuid As Long, pGuid As Any) As Long
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)
If CoCreateInstance(objClsid, 0&, CLSCTX_INPROC_SERVER, idClsid, pvarResult) = S_OK Then
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
End If
End Function
[解决办法]
通过IEmptyVolumeCacheCallBack接口清理IE缓存的类
http://blog.csdn.net/Modest/archive/2006/10/17/1338391.aspx
(声明：魏滔序原创，转贴请注明出处。)
在IE缓存目录中积累着很多的文件， 这些文件虽然可以提高浏览旧网页的速度，但是对磁盘空间的占用也与时俱进。对于爱“干净”的人，总觉得有点得不偿失。下面就贴出清理缓存的源码，清理缓存的方法有很多，这里介绍的是通过IEmptyVolumeCacheCallBack接口实现的例子。
新建工程，引用 olelib.tlb (可以从http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip下载)
建一个类，名称：IETempClear
粘贴如下源码：
Option Explicit
Implements IEmptyVolumeCacheCallBack
Private Const IID_IEmptyVolumeCache = "{8FCE5227-04DA-11d1-A004-00805F8ABE06} "
Private Const CLSID_TemporaryCleaner = "{9B0EFD60-F7B0-11D0-BAEF-00C04FC308C9} " '临时文件
Private Const CLSID_OffLineCleaner = "{8E6E6079-0CB7-11D2-8F10-0000F87ABD16} " '脱机文件
Private TemporaryFiles As IEmptyVolumeCache '临时文件
Private OffLinePages As IEmptyVolumeCache '脱机文件
Private Const HKEY_OFFLINE_PAGES = "Software\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Offline Pages Files "
Private Const HKEY_TEMPORARY = "Software\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Internet Cache Files "
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private 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
Private Declare Function RegCloseKey Lib "advapi32 " (ByVal hKey As Long) As Long
Private mSize As Currency
Property Get SpaceSize() As Long
SpaceSize = mSize
End Property
'根据GUID实例化清理器对象
Private Function CreateCleaner(ByVal GUID As String) As IEmptyVolumeCache
Dim CLSID As UUID, IID As UUID
Dim Unknown As IUnknown
CLSIDFromString GUID, CLSID
CLSIDFromString IID_IEmptyVolumeCache & vbNullChar, IID
CoCreateInstance CLSID, Unknown, CLSCTX_INPROC_SERVER, IID, CreateCleaner
End Function
Public Sub StarClear()
OffLinePages.Purge mSize / 10000, Me
TemporaryFiles.Purge mSize / 10000, Me
End Sub
' 初始化清理器对象
Private Sub InitializeCleaners()
Dim Name As Long, Desc As Long, Flags As Long
Dim hKey As Long, Drive As String, PIDL As Long
'获得临时文件所在驱动器
Drive = Space$(260)
PIDL = SHGetSpecialFolderLocation(0, CSIDL_INTERNET_CACHE)
SHGetPathFromIDList PIDL, Drive
Drive = Left$(Drive, 3)
CoTaskMemFree PIDL
'脱机
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, HKEY_OFFLINE_PAGES, 0&, KEY_ALL_ACCESS, hKey) = 0 Then
OffLinePages.Initialize hKey, Drive, Name, Desc, Flags
CoTaskMemFree Name
CoTaskMemFree Desc
RegCloseKey hKey
End If
'临时
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, HKEY_TEMPORARY, 0&, KEY_ALL_ACCESS, hKey) = 0 Then
TemporaryFiles.Initialize hKey, Drive, Name, Desc, Flags
CoTaskMemFree Name
CoTaskMemFree Desc
RegCloseKey hKey
End If
End Sub
Private Sub Class_Initialize()
Dim Size As Currency
Set OffLinePages = CreateCleaner(CLSID_OffLineCleaner)
Set TemporaryFiles = CreateCleaner(CLSID_TemporaryCleaner)
Call InitializeCleaners
TemporaryFiles.GetSpaceUsed Size, Me
mSize = Size * 10000
OffLinePages.GetSpaceUsed Size, Me
mSize = mSize + (Size * 10000)
End Sub
Private Sub Class_Terminate()
Dim Flags As Long
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 olelib.IEmptyVolumeCacheCallBackFlags, ByVal pcwszStatus As Long)
'
End Sub
Private Sub IEmptyVolumeCacheCallBack_ScanProgress(ByVal dwlSpaceUsed As Currency, ByVal dwFlags As olelib.IEmptyVolumeCacheCallBackFlags, ByVal pcwszStatus As Long)
'
End Sub
使用方法：
Private Sub Command1_Click()
Dim IEClear As New IETempClear
MsgBox "IE缓存占用空间： " & IEClear.SpaceSize & " 字节。 "
IEClear.StarClear
Set IEClear = Nothing
End Sub
[解决办法]
HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\TypedURLs
到这里清除就ok
[解决办法]
bangding
