VBScript & COM: Очистка истории Проводника

 
 'Скрипт предназначен для очистки журнала истории 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