Тема: VBScript & COM: Очистка истории Проводника
Без гарантий. Используете на свой страх и риск.
Скрипт предназначен для очистки журнала истории Проводника и Internet Explorer, и основан на вызове функций интерфейса IUrlHistoryStg2 средствами COM API.
Потребуется зарегистрированная библиотека scrsvc.dll
ОС WinXP/7
ClearHistory.vbs
'Скрипт предназначен для очистки журнала истории Internet Explorer,
'и основан на вызове интерфейса IUrlHistoryStg2 средствами COM API.
'ОС WinXP/7
Option Explicit
Dim iAnsw
Dim oScrSvc, oShellApp
Dim r
Dim sPath
Dim oWindow
Dim GUID1, GUID2, pVarRes
Dim lData
'/Контрольное сообщение/
'---------------------------------------------------------------
iAnsw = MsgBox("Очистить журнал Explorer?", vbYesNo + vbSystemModal + vbInformation, "Очистка журнала")
If iAnsw = vbNo Then QuitMe()
'Интерфейс [IUrlHistoryStg2]
'---------------------------------------------------------------
Const CLSID_Url = "{3C374A40-BAE4-11CF-BF7D-00AA006946EE}"
Const UUID_IUrlHistoryStg2 = "{AFA0DC11-C313-11D0-831A-00C04FD5AE38}"
'Методы интерфейса IUrlHistoryStg2;
Const IUrlHistoryStg2_Release = 8
Const IUrlHistoryStg2_ClearHistory = 36
Const CLSCTX_INPROC_SERVER = 1
Const CC_STDCALL = 4
Const S_OK = 0
'---------------------------------------------------------------
Set oScrSvc = CreateObject("ScriptService.Service")
Set oShellApp = CreateObject("Shell.Application")
'---------------------------------------------------------------
sPath = WScript.ScriptFullName
sPath = Left(sPath,InStrRev(sPath,"\") - 1)
'/Навигация, поиск заданного окна Shell Explorer и отображение журнала/
'-------------------------------------------------------
oShellApp.Open sPath
For Each oWindow In oShellApp.Windows
If InStr(1, LCase(TypeName(oWindow.Document)), "ishellfolderviewdual") <> 0 Then
If StrComp(oWindow.Document.Folder.Self.Path, sPath, 1) = 0 Then
oWindow.Application.ShowBrowserBar "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}", True
Exit For
End If
End If
Next
WScript.Sleep(500)
'/Запрос интерфейса IUrlHistoryStg2 и вызов его функций/
'---------------------------------------------------------------
With oScrSvc
'Выделение памяти
'-------------------------------------------------------
GUID1 = .struct_setval(String(8,Chr(32))) '8*2=16 итоговое количество байт
GUID2 = .struct_setval(String(8,Chr(32))) '8*2=16 итоговое количество байт
pVarRes = .struct_setval(String(2,Chr(32))) '2*2=4 итоговое количество байт
'-------------------------------------------------------
.set_vararg 0, 0
.api_call "OLE32.DLL","CoInitialize", 1
'Запрос интерфейса
'-------------------------------------------------------
.set_strarg 0, CLSID_Url, True
.set_vararg 1, GUID1
r = .api_call("OLE32.DLL","CLSIDFromString",2)
CheckResult r, "CLSIDFromString"
.set_strarg 0, UUID_IUrlHistoryStg2, True
.set_vararg 1, GUID2
r = .api_call("OLE32.DLL","CLSIDFromString",2)
CheckResult r, "CLSIDFromString"
.set_vararg 0, GUID1
.set_vararg 1, 0
.set_vararg 2, CLSCTX_INPROC_SERVER
.set_vararg 3, GUID2
.set_vararg 4, pVarRes
r = .api_call("OLE32.DLL","CoCreateInstance",5)
CheckResult r, "CoCreateInstance"
lData = .struct_getval(pVarRes, 0, 4)
'Вызов интерфейсных функций, очистка журнала
'-------------------------------------------------------
DispCall lData, IUrlHistoryStg2_ClearHistory
DispCall lData, IUrlHistoryStg2_Release
'-------------------------------------------------------
.api_call "OLE32.DLL","CoUninitialize",0
'-------------------------------------------------------
WScript.Sleep(50)
MsgBox "Журнал очищен.", vbSystemModal + vbInformation, "Очистка журнала"
QuitMe()
End With
'/Вызов функции интерфейса без аргументов/
'---------------------------------------------------------------
Function DispCall(lClass, iMethod)
Dim res
res = oScrSvc.struct_setval(String(2,Chr(32))) '2*2=4 итоговое количество байт
With oScrSvc
.set_vararg 0, lClass
.set_vararg 1, iMethod
.set_vararg 2, CC_STDCALL
.set_vararg 3, 0
.set_vararg 4, 0
.set_vararg 5, 0
.set_vararg 6, 0
.set_vararg 7, res
r = .api_call("OLEAUT32.DLL","DispCallFunc",8)
DispCall = .struct_getval(res, 0, 4)
End With
CheckResult r, "DispCallFunc"
End Function
'/Проверка ошибки/
'---------------------------------------------------------------
Sub CheckResult(x, sSource)
If x <> S_OK Then
MsgBox "Сбой выполнения. Источник" & sSource, vbSystemModal + vbExclamation, "Error"
QuitMe()
End If
End Sub
'/Завершение работы/
'---------------------------------------------------------------
Sub QuitMe()
Set oShellApp = Nothing
Set oScrSvc = Nothing
WScript.Quit()
End Sub