<#Module=WMILocator>

	Public ObjServices	'Корневой объект пространства имен
	Public ISWbemObject	'Объект класса

	Public IsRetreived
	Public StopList
	Public DataArrSort
	Public hWnd
	Public sBarhWnd
	Public ConnectSpace
	Public SubSpaceStr

	Const VK_ESCAPE = &H1B
	Const LB_FINDSTRING = &H18F
	Const SB_SETTEXT = &H401

	Const WS_BORDER = &H00800000
	Const WS_CHILD = &H40000000
	Const WS_OVERLAPPED = 0
	Const WS_OVERLAPPEDWINDOW = &H00CF0000
	Const WS_VISIBLE = &H10000000

'-----------------------------------------------------------------------------------------
Sub Load(cmdstr)

	Dim RootSpace
	
	On Error Resume Next

	'[Запрос корневого пространства имен]
	'---------------------------------------------------------------------------------
	RootSpace = InputBox( "Укажите корневое пространство имен:", "Подключение к пространству имен", "winmgmts:\\.\root")
	If Len(RootSpace) = 0 Then 
		EndMF
		Exit Sub
	End If

	'[Установка параметров формы]
	'---------------------------------------------------------------------------------				
	With InitForm

		.Caption = "Выбор пространства подключения"
		.Width = 400*vbPx
		.Height = 150*vbPy
		.Style.ToolWindow = True
		.Style.CloseButton = False
		'-------------------------------------------------------------------------
		.Add "Label", 1, "Left=5","Top=5","Width=380","Height=20", _
					"Alignment=2","Caption=""Подпространства имен WMI"""
		.Add "Combo", 1,  "Left=5","Top=30","Width=380","Height=30", _
					"Alignment=2","Text= "
		.Add "Command", 10, "Left=5","Top=75","Width=180","Height=30", _
					"Caption=""Подключить"""
		.Add "Command", 20, "Left=205","Top=75","Width=180","Height=30", _
					"Caption=""Закрыть""","Cancel=True"

		'[Параметры оформления]
		'------------------------------------------------------------------------
		For Each Control In .Controls
			On Error Resume Next
			With Control
				.FontName = "Verdana"
				.FontSize = 10
			End With
		Next

		'[Заполнение раскрывающегося списка]
		'------------------------------------------------------------------------
		WalkNamespace(RootSpace)
		.Combo(1).ListIndex = 0
		.Combo(1).SelLength = 0
		'-------------------------------------------------------------------------
		.Visible=True
		DoEvents
	End With	
End Sub


'---------------[Вывод возможных подпространств для корневого пространства имен]----------
'-----------------------------------------------------------------------------------------
Sub WalkNamespace(NameSpaceStr)

	Dim ObjNameSpace
	Dim ColNamespaces

	On Error Resume Next
	'--------------------------------------------------------------------------------
	Set ObjNameSpace = GetObject(NameSpaceStr)

		If Not IsObject(ObjNameSpace) Then 
			MsgBox "Невозможно подключится к заданному пространству.",vbSystemModal + vbExclamation, "Ошибка подключения"
			EndMF
			Exit Sub
		End If
		
	Set ColNamespaces = ObjNameSpace.InstancesOf("__NAMESPACE")
		
	'--------------------------------------------------------------------------------
	If ColNamespaces.count > 0 Then
		For Each Obj In ColNamespaces
			Initform.Combo(1).AddItem NameSpaceStr & "\" & Obj.Name 
			DoEvents
			WalkNamespace NameSpaceStr & "\" & Obj.Name
		Next
	End If

End Sub

'------------[Подключение к пространству имен и оформление формы]-------------------------
'-----------------------------------------------------------------------------------------
Sub CreateWMIForm()

	On Error Resume Next

	'[Установка параметров формы]
	'----------------------------------------------------------------------------------	
	With WMIForm
		.Caption = "WMI Class Viewer"
		.Width = 780*vbPx
		.Height = 450*vbPy
		'------------------------------------------------------------------------
		.Add "Label", 1, "Left=5","Top=5","Width=300","Height=20", _
					"Alignment=2","Caption=""Классы WBEM"""
		.Add "List", 1,  "Left=5","Top=25","Width=300","Height=300", _
					"ToolTipText=""Список классов"""
		'------------------------------------------------------------------------
		.Add "COption", 1, "Left=5",  "Top=310","Width=90","Height=30", _
					"Caption=""Системные Классы"""
		.Add "COption", 2, "Left=105","Top=310","Width=90","Height=30", _
					"Caption=""Классы CIM"""
		.Add "COption", 3, "Left=200","Top=310","Width=90","Height=30", _
					"Caption=""Классы Win32"""
		'------------------------------------------------------------------------
		.Add "Label", 2, "Left=315","Top=5","Width=450","Height=20", _
					"Alignment=2","Caption=""Свойства класса"""
		.Add "List", 2, "Left=315","Top=25","Width=450","Height=100", _
					"ToolTipText=""Список свойств класса"""
		'------------------------------------------------------------------------
		.Add "Label", 3, "Left=315","Top=115","Width=450","Height=20", _
					"Alignment=2","Caption=""Значение свойств[двойной щелчок чтобы скопировать в буфер]"""
		.Add "List", 3, "Left=315","Top=135","Width=450","Height=100", _
					"ToolTipText=""Список значений свойств для всех экземпляров класса"""
		'------------------------------------------------------------------------
		.Add "Label", 4, "Left=315","Top=225","Width=450","Height=20", _
					"Alignment=2","Caption=""Методы класса"""
		.Add "List", 4, "Left=315","Top=245","Width=450","Height=100", _
					"ToolTipText=""Список методов класса"""
		'------------------------------------------------------------------------
		.Add "MText", 1, "Left=5","Top=350","Width=300","Height=20", _
					"ToolTipText=""Поле ввода поиска класса"""

		'------------------------------------------------------------------------
		.Add "Command", 1, "Left=315","Top=350","Width=200","Height=30", _
					"Caption=""Информация"""
		'------------------------------------------------------------------------
		.Add "Command", 2, "Left=530","Top=350","Width=200","Height=30", _
					"Caption=""Выход"""
		
		'[Параметры оформления]
		'------------------------------------------------------------------------
		For Each Control In .Controls
			On Error Resume Next
			With Control
				.FontName = "Verdana"
				.FontSize = 10
			End With
		Next
		'------------------------------------------------------------------------
		hWnd = .List(1).hWnd
		
	End With
	sBarhWnd = CreateStatusBar()

End Sub

'---------------------[Получение массива имен классов WMI]--------------------------------
'-----------------------------------------------------------------------------------------
Sub GetClassList()

	Dim DataArr()
	Dim ISWbemObjectSet

	On Error Resume Next	
	'---------------------------------------------------------------------------------
	SendMsg sBarhWnd,SB_SETTEXT,0,"Подождите..."	


	Set ISWbemObjectSet = ObjServices.SubclassesOf() 
	'---------------------------------------------------------------------------------
	i = 1
	For Each ISWbemObject In ISWbemObjectSet
		ReDim Preserve DataArr(i)
		DataArr(i-1) = ISWbemObject.Path_.Class
		i = i + 1
	
	Next
	'---------------------------------------------------------------------------------
	IsRetreived = True
	DataArrSort = Sys.Sort(DataArr)

	SendMsg sBarhWnd,SB_SETTEXT,0,"Готово"

End Sub

'-------------[Вывод списка классов WMI с учетом фильтра префикса класса]-----------------
'-----------------------------------------------------------------------------------------
Sub FillClassList(Prefix)

	On Error Resume Next	

	WMIForm.List(1).Clear	
	StopList = True

	Set ISWbemObject = Nothing
	'--------------------------------------------------------------------------------
	WMIForm.List(2).Clear	
	WMIForm.List(3).Clear
	WMIForm.List(4).Clear	
	'--------------------------------------------------------------------------------
	SendMsg sBarhWnd, SB_SETTEXT, 0, "Подождите..."	

	WMIForm.Mtext(1).Text = Prefix
	'--------------------------------------------------------------------------------	
	For Each ClsName In DataArrSort
		If InStr(1,ClsName,Prefix,1) Then WMIForm.List(1).AddItem ClsName 
		'DoEvents
	Next
	'--------------------------------------------------------------------------------
	SendMsg sBarhWnd,SB_SETTEXT,0,"Готово"


End Sub
'-----------------------------------------------------------------------------------------


'--------------[Вывод доступных свойств и методов заданного класса]-----------------------
'-----------------------------------------------------------------------------------------
Sub FillAvailablePropsAndMethods()

	Dim ISWbemPropertySet, ISWbemMethodSet
	
	On Error Resume Next
	
	WMIForm.List(2).Clear	
	WMIForm.List(3).Clear
	WMIForm.List(4).Clear	
	'--------------------------------------------------------------------------------
	Set ISWbemObject = Nothing	

	Set ISWbemObject = ObjServices.Get(WMIForm.List(1).Text)
	Set ISWbemPropertySet = Eval("ISWbemObject.Properties_")
	Set ISWbemMethodSet = Eval("ISWbemObject.Methods_")	
	Sys.Sleep(100)

	'--------------------------------------------------------------------------------
	For Each ISWbemProperty In ISWbemPropertySet
		WMIForm.List(2).AddItem ISWbemProperty.Name
		DoEvents
	Next
	'--------------------------------------------------------------------------------
	Sys.Sleep(100)

	For Each ISWbemMethod In ISWbemMethodSet
		WMIForm.List(4).AddItem ISWbemMethod.Name
		DoEvents
	Next
End Sub

'---------[Вывод списка значений свойств для всех экземпляров выбранного класса]----------
'-----------------------------------------------------------------------------------------
Sub ShowPropertySet()

	Dim ISWbemInstanceSet

	On Error Resume Next

	StopList = False
	WMIForm.List(3).Clear
	
	SendMsg sBarhWnd, SB_SETTEXT, 0, "Подождите...[ESC чтобы остановить]"
	'--------------------------------------------------------------------------------
	Set ISWbemInstanceSet = Eval("ObjServices.Get(WMIForm.List(1).Text).Instances_(16+32)")

	For Each ISWbemInstance In ISWbemInstanceSet
		WMIForm.List(3).AddItem ISWbemInstance.Properties_.Item(WMIForm.List(2).Text).Value
		DoEvents
		Sys.Sleep(10)

		' Остановить по нажатию ESC
		If CheckKeyState()<>0 Or StopList Then 
			StopList = False
			Exit Sub
		End If
	Next

	SendMsg sBarhWnd,SB_SETTEXT,0,"Готово"

End Sub

'---------------------------[Проверка состояния клавиши ESC]------------------------------
'-----------------------------------------------------------------------------------------
Function CheckKeyState()

	CheckKeyState = Sys.DynApi.CallFunction( _
					"USER32.DLL", _
					"GetAsyncKeyState", _
					VK_ESCAPE)
End Function

'---------------------------[Посылка сообщения дочернему окну]----------------------------
'-----------------------------------------------------------------------------------------
Function SendMsg(hWnd,MsgID,LParam,WParam)

	SendMsg = Sys.DynApi.CallFunction( _
					"USER32.DLL", _
					"SendMessageA", _
					hWnd, _
					MsgID, _
					LParam, _
					WParam)
	DoEvents
	
End Function

'---------------------------[Создание строки состояния]----------------------------------
'-----------------------------------------------------------------------------------------
Function CreateStatusBar()

	CreateStatusBar = Sys.DynApi.CallFunction( _
					"COMCTL32.DLL", _
					"CreateStatusWindowA", _
					WS_OVERLAPPEDWINDOW Or WS_VISIBLE Or WS_CHILD, _
					"WBEM Class Viewer", _
					WMIForm.hWnd, _
					0)
	DoEvents	
End Function
<#Module>


'-------------------------[Обработка событий окна управления]-----------------------------
'-----------------------------------------------------------------------------------------
<#Form=WMIForm>
	'---------------------------------------------------------------------------------
	Sub COption1_Click()
		FillClassList("__")
	End Sub
	'---------------------------------------------------------------------------------
	Sub COption2_Click()
		FillClassList("CIM_")
	End Sub
	'---------------------------------------------------------------------------------
	Sub COption3_Click()
		FillClassList("Win32_")
	End Sub
	'---------------------------------------------------------------------------------
	Sub List1_Click()
		StopList = True	'Для остановки вывода списка значений свойств
		SendMsg sBarhWnd,SB_SETTEXT,0,"Класс: " & WMIForm.List(1).Text
		FillAvailablePropsAndMethods()
	End Sub
	'---------------------------------------------------------------------------------
	Sub List2_Click()
		ShowPropertySet()
		SendMsg sBarhWnd,SB_SETTEXT,0,"Свойство: " & WMIForm.List(2).Text
     	End Sub
	'---------------------------------------------------------------------------------
	Sub List3_Click()
		SendMsg sBarhWnd,SB_SETTEXT,0,"Значение: " & WMIForm.List(3).Text
	End Sub
	'---------------------------------------------------------------------------------
	Sub List3_DblClick()

		Dim sTxt
		sTxt = CStr(WMIForm.List(3).Text)
		Sys.Clipboard.Clear 
		Sys.ClipBoard.SetText sTxt

		MsgBox sTxt & vbCRLF & "[Скопировано в буфер обмена]", vbSystemModal + vbExclamation, "Значение свойства."
	
	End Sub
	'---------------------------------------------------------------------------------


	'----------------------[Поиск по списку классов]---------------------------------
	'---------------------------------------------------------------------------------
	Sub MText1_KeyUp(KeyCode,Shift) 

		Dim Data, Index

		On Error Resume Next

		Data = CStr(WMIForm.MText(1).Text)
		Index = SendMsg(hWnd,LB_FINDSTRING,-1,Data)
		WMIForm.List(1).Selected(Index) = True
		DoEvents
	End Sub

	'------------------[Вывод описания входных параметров метода]---------------------
	'---------------------------------------------------------------------------------
	Sub List4_Click()

		On Error Resume Next

		SendMsg sBarhWnd,SB_SETTEXT,0,"Метод: " & WMIForm.List(4).Text

		MsgBox _
		"Метод:" & WMIForm.List(4).Text & vbCR & vbCR & vbCR & _
		Eval("ISWbemObject.Methods_(WMIForm.List(4).Text).InParameters.GetObjectText_"), _
		vbSystemModal + vbExclamation,"Описание входных параметров"
	End Sub

	'--------------------------[Вывод описания класса]--------------------------------
	'---------------------------------------------------------------------------------
	Sub Command1_Click()

		Dim ObjPath
		Dim ObjText, Brd, FilePath
	
		On Error Resume Next
		
		If Not IsObject(ISWbemObject) Or WMIForm.List(1).ListIndex=-1 Then Exit Sub
		'-------------------------------------------------------------------------
		Set ObjPath = Eval("ISWbemObject.Path_")
			ObjText = Replace(Eval("ISWbemObject.GetObjectText_"),vbLF,vbCRLF,1)
			Brd = String(64,"-")
		'-------------------------------------------------------------------------
		StrInfo = Brd		& vbCRLF & _
			"//Описание класса WMI//"	& vbCRLF & _
			ObjText			& vbCRLF & _
			Brd			& vbCRLF & _
			"//Пространство имен//"	& vbCRLF & _
			ObjPath.NameSpace	& vbCRLF & _
			Brd			& vbCRLF & _
			"//Сервер//"		& vbCRLF & _
			ObjPath.Server		& vbCRLF & _				
			Brd			& vbCRLF & _
			"//Строка подключения//"	& vbCRLF & _
			ObjPath.DisplayName	& vbCRLF & _
			Brd	
			
		FilePath = Sys.WinInfo("temp") & "\cls_info.txt"
		'-------------------------------------------------------------------------
		Sys.Conv.Str2File StrInfo, FilePath
		Sys.Shell "notepad.exe " & FilePath
		DoEvents
	End Sub
	'---------------------------------------------------------------------------------
	Sub Command2_Click()
		WMIForm.UnloadForm
		InitForm.UnloadForm
		
	End Sub
	'---------------------------------------------------------------------------------
	Sub Form_Unload()
		InitForm.UnloadForm
		
	End Sub
<#Form>


'-----------------------------------------------------------------------------------------
<#Form=InitForm>

	'[Подключение к заданному пространству имен с выводом данных]
	'---------------------------------------------------------------------------------
	Sub Command10_Click()

		On Error Resume Next
		'-------------------------------------------------------------------------
		Set ObjServices = Nothing
		Set ObjServices = GetObject(CStr(InitForm.Combo(1).Text))

		Sys.Sleep(100)
		'-------------------------------------------------------------------------
		If Not IsObject(ObjServices) Then 
			MsgBox "Невозможно подключится к заданному пространству.",vbSystemModal + vbExclamation, "Ошибка подключения"
			Exit Sub
		End If

		'[Создание формы(в случае необходимости) и установка её параметров]
		'--------------------------------------------------------------------------
		If Not WMIForm.Visible Then CreateWMIForm()

		IsRetreived = False
		StopList = False
		'------------------------------------------------------------------------
			Sys.Sleep(200)
			GetClassList()
			WMIForm.Caption = "WMI Class Viewer [" & CStr(InitForm.Combo(1).Text) & "]"
			WMIForm.Style.ToolWindow = True
			WMIForm.COption(1).Value = True
			WMIForm.Visible = True
			DoEvents
			
			WMIForm.Left = 10*vbPx
			WMIForm.Top = 10*vbPy
			DoEvents

	End Sub
	'---------------------------------------------------------------------------------
	Sub Command20_Click()
		InitForm.UnloadForm
		
	End Sub
	'---------------------------------------------------------------------------------
	Sub Form_Unload()

		Set ObjServices	= Nothing
		Set ISWbemObject = Nothing
		Sys.Sleep(200)	

		EndMF
		DoEvents
	End Sub
<#Form>