Тема: LangMF 9.0: просмотр классов WMI
Без гарантий. Используете на свой страх и риск.
Скрипт-утилита [WMIViewer2.mf] предназначена для просмотра классов WMI находящихся в заданном пространстве имен, просмотра свойств и методов выбранного класса. Также позволяет просматривать значение заданного свойства для всех экземпляров выбранного класса.
Потребуется установленный LangMF 9.0
OC WinXP
По мотивам статьи [Введение в Windows Management Instrumentation (WMI)].
<#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>