IEの履歴

仕事でIEの履歴を削除するプログラムを作ることになった。
涙が出そうなくらい大変だったので残しておく。
とりあえずメモメモ


C:\Documents and Settings\ユーザ\Local Settings\History以下に「今日」、「先週」等があるがこれらを消すのではない。
消すのはHistory\History.IE5以下にあるindex.datである。
「MSHist****」ディレクトリにindex.datがありIEの履歴情報を持っている。
だから、index.datを消せば履歴も消える。


しかし、今現在ログインしているユーザのindex.datはWindowsが掴んでいるので普通には消せない。


Windowsが掴んでいて消せないのならば、掴んでいないときに消せばいい。
レジストリキーを使えば何とかなる。
「HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager」に
「PendingFileRenameOperations」を追加して消す。


ただし、問題がある。
プログラムを実行して再起動すれば履歴は消える。
しかし、「今日」、「先週」などは残ったまま。
こいつも消さなくてはならないのでレジストリキーから消して履歴は完全に消える。


出来たのがこれ↓

'ON ERROR RESUME NEXT

' 定数定義
Const LOCAL_SETTINGS_HISTORY   = &H22&

Const HKLM   = &H80000002
Const SubKey = "SYSTEM\CurrentControlSet\Control\Session Manager"
Const VName  = "PendingFileRenameOperations"

Const IEHistorySubKey = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\5.0\Cache\Extensible Cache\"

' オブジェクト作成
Set objShell  = CreateObject("Shell.Application")
Set objFSO    = CreateObject("Scripting.FileSystemObject")
Set objWShell = WScript.CreateObject("WScript.Shell")

' IE 閲覧記録の削除
Set objFolder  = objShell.Namespace(LOCAL_SETTINGS_HISTORY)
strHistoryPath = objFolder.Items.Item.Path & "\History.IE5"
Dim DelList
DelList = Array
For Each objSubFolder In objFSO.GetFolder(strHistoryPath).SubFolders
    ' 履歴の情報が置いてあるディレクトリのパスを取得
    n = UBound(DelList)
    ReDim Preserve DelList(n + 4)
    DelList(n + 1) = "\??\" & strHistoryPath & "\" & objSubFolder.Name & "\index.dat"
    DelList(n + 2) = vbNullString
    DelList(n + 3) = "\??\" & strHistoryPath & "\" & objSubFolder.Name
    DelList(n + 4) = vbNullString
    
    ' IE 閲覧記録の情報をレジストリより削除
    ' キーが存在しない可能性を考慮し、一度仮のデータを登録した後削除する
    objWShell.RegWrite IEHistorySubKey & objSubFolder.Name & "\Hoge", "Hoge"
    objWShell.RegDelete IEHistorySubKey & objSubFolder.Name & "\"
Next

' 次回起動時にデータを削除するようにレジストリに設定
With GetObject("winmgmts:\root\default:StdRegProv")
    .SetMultiStringValue HKLM, SubKey, VName, DelList
End With

' オブジェクト初期化
Set objShell      = Nothing
Set objFolder     = Nothing
Set objFSO        = Nothing
Set objWShell     = Nothing

完成までに3日もかけてしまいショックだった。
もっと簡単に出来るものだと思っていたから。
3日目なんて「無理」って言葉を何度言ったか分からない。