1 (изменено: Poltergeyst, 2016-01-29 22:30:38)

Тема: VBScript & OLE: Очистка истории Проводника

Без гарантий. Используете на свой страх и риск
Скрипт предназначен для очистки журнала истории Проводника и Internet Explorer, и основан на вызове функций интерфейса IUrlHistoryStg2 средствами OLE API.

Потребуется зарегистрированная библиотека scrsvc.dll
ОС WinXP

ClearHistory.vbs


 
 'Скрипт предназначен для очистки журнала истории Internet Explorer,
 'и основан на вызове интерфейса IUrlHistoryStg2 средствами OLE API.
 'ОС WinXP

 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