on error resume next

MyRoot = &H80000000
Path = "CLSID"
Set obj = GetObject("winmgmts:{impersonationLevel=impersonate}!root/Default:StdRegProv")
obj.EnumKey MyRoot, Path, Names

Set MyIE = CreateObject("InternetExplorer.Application")
With MyIE
   .Navigate "about:blank"
   .Toolbar = 0
   .MenuBar = 0
   .StatusBar = 0
   .Left = 0
   .Top = 0
   .Document.Title = "www.onestyle.com.ua, Специально для книги"
End With

MyIE.Visible = 0

for each i in names
   tmp2 = WMI_RegRead("HKCR\CLSID\" & i & "\System.ControlPanel.Category", 1, 1, 0, 0, 0)
   tmp3 = WMI_RegRead("HKCR\CLSID\" & i & "\", 1, 1, 0, 0, 0)
   
   if len(tmp2) <> 0 then
      mytemp = mytemp & "<tr><td>" & i & " - " & tmp3 & "</td><td>" & tmp2 & "</td></tr>"
   end if
next
mytemp = mytemp & "</table>"

MyIE.Document.Body.InnerHTML = "В Панель управления нового вида добавлены следующие ActiveX-объекты: </br><table><tr><td style='font-weight:bold;'>GUID-номер</td><td style='font-weight:bold;'>Категории Панели управления</td></tr>" & mytemp
MyIE.Visible = 1

MsgBox "Когда вы нажмете ОК, окно браузера закроется..."
MyIE.Quit()
Set MyIE = Nothing
WScript.Quit()

'ФУНКЦИИ
Function WMI_RegRead (path, p_sz, p_esz, p_msz, p_dw, p_bin)
	Dim MyRoot, MyHead
	MyParam = ""
	Dim MyArr ()
	ReDim MyArr (16)	

	On Error Resume Next
	Set WMIRegTmp = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/Default:StdRegProv")

	select case Left(path, 4)
	Case "HKCR"
		MyRoot = &H80000000
	Case "HKCU"
		MyRoot = &H80000001
	Case "HKLM"
		MyRoot = &H80000002
	Case Else
		WMI_RegRead = EMPTY
		Set WMIRegTmp = Nothing
		Exit Function		
	End select
	Path = Right(Path, Len(Path) - 5)
	
	Do While Right(Path, 1) <> "\"
		If Len(Path) < 2 then Exit Do
		MyParam = Right(Path, 1) & MyParam 
		Path = Left(Path, Len(Path) - 1)		
	Loop
	  
	MyHead = Left(Path, Len(Path) - 1)
	
	if p_sz = 1 then
	temp = WMIRegTmp.GetStringValue (MyRoot,MyHead, MyParam, value)
	if temp = 0 then
		WMI_RegRead = value
		PType = "REG_SZ"
		Erase MyArr
		Exit Function
	end if
	end if
	
	if p_esz = 1 then
	temp = WMIRegTmp.GetExpandedStringValue (MyRoot,MyHead, MyParam, value)
	if temp = 0 then
		WMI_RegRead = value
		PType = "REG_EXPAND_SZ"
		Erase MyArr
		Exit Function
	end if
	end if

	if p_dw = 1 then
	temp = WMIRegTmp.GetDWORDValue (MyRoot,MyHead, MyParam, value)
	if temp = 0 then
		WMI_RegRead = Hex(value)
		PType = "REG_DWORD"
		Erase MyArr
		Exit Function
	end if
	end if

	if p_msz = 1 then
	temp = WMIRegTmp.GetMultiStringValue (MyRoot,MyHead, MyParam, MyArr)
	if temp = 0 then
		value = ""
		for each i in MyArr
			value = value & i & " NULL "
		Next
		value = Left(value, Len(value) - 6)
		WMI_RegRead = value
		PType = "REG_MULTI_SZ"
		Erase MyArr
		Exit Function
	end if
	end if

	if p_bin = 1 then
	temp = WMIRegTmp.GetBinaryValue (MyRoot,MyHead, MyParam, MyArr)
	if temp = 0 then
		value = ""
		for each i in MyArr
			value = value & Hex(i)
		Next
		WMI_RegRead = value
		PType = "REG_BINARY"
		Erase MyArr
		Exit Function
	end if
	end if

	PType = "NONE" 
	RegRead = EMPTY
End Function