' Copyright (c) 1997-1999 Microsoft Corporation VERSION 5.00 Begin VB.Form frmObjectEditor BorderStyle = 1 'Fixed Single Caption = "Object Editor" ClientHeight = 6600 ClientLeft = 45 ClientTop = 330 ClientWidth = 7395 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6600 ScaleWidth = 7395 StartUpPosition = 2 'CenterScreen Begin VB.CommandButton cmdAssoc Caption = "Associators" Height = 445 Left = 6120 TabIndex = 26 Top = 3600 Width = 1215 End Begin VB.CommandButton cmdRefs Caption = "References" Height = 445 Left = 6120 TabIndex = 25 Top = 3000 Width = 1215 End Begin VB.CommandButton cmdClass Caption = "Class" Height = 445 Left = 6120 TabIndex = 24 Top = 2400 Width = 1215 End Begin VB.CheckBox chkMethLocal Caption = "Local Only" Height = 195 Left = 3840 TabIndex = 23 Top = 4920 Width = 1455 End Begin VB.CheckBox chkLocal Caption = "Local Only" Height = 255 Left = 4200 TabIndex = 22 Top = 2160 Width = 1335 End Begin VB.CheckBox chkHideSysProp Caption = "Hide System Properties" Height = 255 Left = 1920 TabIndex = 21 Top = 2160 Width = 2175 End Begin VB.CommandButton cmdDelMethod Caption = "Delete Method" Height = 320 Left = 3000 TabIndex = 20 Top = 6120 Width = 1335 End Begin VB.CommandButton cmdEditMethod Caption = "Edit Method" Height = 320 Left = 1560 TabIndex = 19 Top = 6120 Width = 1335 End Begin VB.CommandButton cmdAddMethod Caption = "Add Method" Height = 320 Left = 120 TabIndex = 18 Top = 6120 Width = 1335 End Begin VB.ListBox lstMethods Height = 840 Left = 120 Sorted = -1 'True TabIndex = 17 Top = 5160 Width = 5775 End Begin VB.CommandButton cmdDelProp Caption = "Delete Property" Height = 320 Left = 3000 TabIndex = 15 Top = 4440 Width = 1335 End Begin VB.CommandButton cmdEditProp Caption = "Edit Property" Height = 320 Left = 1560 TabIndex = 14 Top = 4440 Width = 1335 End Begin VB.CommandButton cmdAddProp Caption = "Add Property" Height = 320 Left = 120 TabIndex = 13 Top = 4440 Width = 1335 End Begin VB.ListBox lstProperties Height = 1620 Left = 120 Sorted = -1 'True TabIndex = 12 Top = 2520 Width = 5775 End Begin VB.CommandButton cmdDelQual Caption = "Delete Qualifier" Height = 320 Left = 3000 TabIndex = 10 Top = 1680 Width = 1335 End Begin VB.CommandButton cmdEditQual Caption = "Edit Qualifier" Height = 320 Left = 1560 TabIndex = 9 Top = 1680 Width = 1335 End Begin VB.CommandButton cmdAddQual Caption = "Add Qualifier" Height = 320 Left = 120 TabIndex = 8 Top = 1680 Width = 1335 End Begin VB.CommandButton cmdInstances Caption = "Instances" Height = 445 Left = 6120 TabIndex = 7 Top = 3600 Width = 1215 End Begin VB.CommandButton cmdDerived Caption = "Derived" Height = 445 Left = 6120 TabIndex = 6 Top = 3000 Width = 1215 End Begin VB.CommandButton cmdSuperclass Caption = "Superclass" Height = 445 Left = 6120 TabIndex = 5 Top = 2400 Width = 1215 End Begin VB.CommandButton cmdShowMOF Caption = "Show MOF" Height = 445 Left = 6120 TabIndex = 4 Top = 1800 Width = 1215 End Begin VB.CommandButton cmdSaveObject Caption = "&Save Object" Height = 445 Left = 6120 TabIndex = 3 Top = 840 Width = 1215 End Begin VB.CommandButton cmdClose Caption = "&Close" Height = 445 Left = 6120 TabIndex = 2 Top = 240 Width = 1215 End Begin VB.ListBox lstQualifiers Height = 1035 Left = 120 Sorted = -1 'True TabIndex = 1 Top = 480 Width = 5655 End Begin VB.Label Label3 Caption = "Methods" Height = 255 Left = 120 TabIndex = 16 Top = 4920 Width = 1095 End Begin VB.Label Label2 Caption = "Properties" Height = 255 Left = 120 TabIndex = 11 Top = 2160 Width = 1335 End Begin VB.Label Label1 Caption = "Qualifiers" Height = 255 Left = 120 TabIndex = 0 Top = 240 Width = 1695 End End Attribute VB_Name = "frmObjectEditor" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim gObjectPath As String Public gppQualSet As ISWbemQualifierSet Public ParentQueryResult As frmQueryResult Public IsEmbedded As Boolean Public gMyPropertyEditor As frmPropertyEditor Public gMyExecMethod As frmExecMethod Public gMyMethodEditor As frmMethodEditor Public ParentInObjectEditor As frmObjectEditor Public ParentOutObjectEditor As frmObjectEditor Public MethodInParams As ISWbemObject Public MethodOutParams As ISWbemObject Public ForceInstance As Boolean Dim gppObject As ISWbemObject Private Sub chkHideSysProp_Click() Call RefreshLists End Sub Private Sub chkLocal_Click() If chkLocal.Value = 1 Then chkHideSysProp.Enabled = False Else chkHideSysProp.Enabled = True End If Call RefreshLists End Sub Private Sub cmdAddMethod_Click() Dim myMethodEditor As New frmMethodEditor myMethodEditor.txtMethodName.Enabled = True myMethodEditor.txtMethodName.BackColor = &H80000005 'White myMethodEditor.txtMethodOrigin.Enabled = False myMethodEditor.txtMethodOrigin.Text = gObjectPath myMethodEditor.cmdEditInput.Enabled = False myMethodEditor.chkEnableInput.Value = 0 myMethodEditor.cmdEditOutput.Enabled = False myMethodEditor.chkEnableOutput.Value = 0 myMethodEditor.optNormal.Value = True myMethodEditor.lstQualifiers.Clear Set myMethodEditor.Parent = Me Set gMyMethodEditor = myMethodEditor 'Must be modal to ensure one set of inparams and outparams this object stores when saving the method myMethodEditor.Show vbModal, frmMain End Sub Private Sub cmdAddQual_Click() Dim myQualifierEditor As New frmQualifierEditor 'First clear out old values myQualifierEditor.txtQualName.Text = "" myQualifierEditor.txtQualValue.Text = "" myQualifierEditor.cmbQualType.Text = "" myQualifierEditor.chkArray.Value = 0 myQualifierEditor.chkDerived.Value = 1 myQualifierEditor.chkInst.Value = 1 myQualifierEditor.chkOverrides.Value = 1 myQualifierEditor.chkPropagated.Value = 0 myQualifierEditor.txtQualName.Enabled = True myQualifierEditor.cmbQualType.Text = "CIM_STRING" gppObject.GetQualifierSet gppQualSet Set myQualifierEditor.Parent = Me myQualifierEditor.Show vbModal, frmMain End Sub Private Sub cmdAssoc_Click() Dim myQuery As New frmQuery strQuery = "Query" myQuery.cmbQueryType.Text = "WQL" myQuery.txtQuery.Text = "associators of {" & gObjectPath & "}" myQuery.cmdApply_Click End Sub Private Sub cmdClass_Click() On Error GoTo errorhandler GetObject CStr(gppObject.Path_.Class) Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Private Sub cmdClose_Click() Unload Me End Sub Public Sub RefreshLists() Dim pname As String Dim isInstance As Boolean Dim TypeOfVar As Integer Dim typeStr As String Dim methodflag As Long Dim pVal As Variant Dim CIMType As Long Dim tmpstr As String On Error GoTo errorhandler lstQualifiers.Clear lstProperties.Clear lstMethods.Clear Caption = "Object Editor for " & gObjectPath If InStr(gObjectPath, ".") > 0 Or ForceInstance = True Then 'Instance cmdInstances.Visible = False cmdSuperclass.Visible = False cmdDerived.Visible = False cmdAssoc.Visible = True cmdClass.Visible = True cmdRefs.Visible = True isInstance = True Else cmdInstances.Visible = True cmdSuperclass.Visible = True cmdDerived.Visible = True cmdAssoc.Visible = False cmdClass.Visible = False cmdRefs.Visible = False isInstance = False End If 'At this point we have the object now fill in the list boxes Dim Qualifier As ISWbemQualifier For Each Qualifier In gppObject.Qualifiers_ lstQualifiers.AddItem Qualifier.Name & Chr(9) & Chr(9) & QualifierType(Qualifier.Value) & Chr(9) & Qualifier.Value Next Dim Property As ISWbemProperty For Each Property In gppObject.Properties_ pVal = Property.Value CIMType = Property.CIMType If IsArray(pVal) Then For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If If pvtType = wbemCimtypeObject Then 'CIM_OBJECT lstProperties.AddItem Property.Name & Chr(9) & Chr(9) & TypeString(CIMType) & Chr(9) & "" Set embeddedObject = pVal Else lstProperties.AddItem Property.Name & Chr(9) & Chr(9) & TypeString(CIMType) & Chr(9) & pVal End If Next 'Get methods except on instances If gppObject.Path_.IsClass = True Then Dim Method As ISWbemMethod For Each Method In gppObject.Methods_ lstMethods.AddItem Method.Name Next cmdAddMethod.Enabled = False cmdEditMethod.Enabled = True cmdDelMethod.Enabled = False Else cmdAddMethod.Enabled = False cmdEditMethod.Enabled = False cmdDelMethod.Enabled = False End If If Me.Visible = False Then If gMyPropertyEditor Is Nothing Then Me.Show vbModeless, frmMain Else Me.Show vbModal, frmMain End If End If 'Work out if we need to disable the superclass button Dim Derivation As Variant Derivation = gppObject.Derivation_ If (Not IsNull(Derivation) And (UBound(Derivation) >= LBound(Derivation))) Then cmdSuperclass.Enabled = True Else cmdSuperclass.Enabled = False End If Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub GetObject(objectPath As String) 'Dim pSink As New ObjectSink On Error GoTo errorhandler gObjectPath = objectPath If frmMain.chkAsync.Value = False Then Set gppObject = Namespace.Get(objectPath) Else 'ppNamespace.GetObjectAsync objectPath, 0, Nothing, pSink 'While IsEmpty(pSink.status) ' DoEvents 'Wend 'Set gppObject = pSink.pObj End If Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub ShowObject(MyObject As ISWbemObject) 'Dim pSink As New ObjectSink Dim val As String On Error GoTo errorhandler val = MyObject.Path_.RelPath If IsNull(val) Then val = MyObject.Path_.Class End If gObjectPath = val Set gppObject = MyObject Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub NewDerivedClass(objectPath As String) 'Dim pSink As New ObjectSink Dim Object As ISWbemObject On Error GoTo errorhandler If frmMain.chkAsync.Value = 0 Then Set Object = Namespace.Get(objectPath) Else 'ppNamespace.GetObjectAsync objectPath, 0, Nothing, pSink 'While IsEmpty(pSink.status) ' DoEvents 'Wend 'Set ppObject = pSink.pObj End If Set gppObject = Object.SpawnDerivedClass_ gObjectPath = "" Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Private Sub cmdAddProp_Click() Dim myPropertyEditor As New frmPropertyEditor 'Firt Clear out old values myPropertyEditor.txtProperty.Text = "" myPropertyEditor.txtOrigin.Text = gObjectPath myPropertyEditor.cmbType.Text = "CIM_STRING" myPropertyEditor.cmdView.Visible = False myPropertyEditor.txtValue.Text = "" myPropertyEditor.chkArray.Value = 0 myPropertyEditor.lstQualifiers.Clear 'Enable some boxes since we are adding a new property myPropertyEditor.txtProperty.Enabled = True myPropertyEditor.cmbType.Enabled = True myPropertyEditor.optIndexed.Enabled = True myPropertyEditor.optKey.Enabled = True myPropertyEditor.optNormal.Enabled = True myPropertyEditor.optNormal.Value = True myPropertyEditor.optNotNull2.Enabled = True myPropertyEditor.chkArray.Value = 0 myPropertyEditor.optNULL.Value = True myPropertyEditor.cmdView.Enabled = False myPropertyEditor.txtValue.Enabled = False Set myPropertyEditor.Parent = Me myPropertyEditor.Show vbModal, frmMain End Sub Private Sub cmdDelQual_Click() Dim strQualifierName As String Dim QualSet As ISWbemQualifierSet On Error GoTo errorhandler If lstQualifiers.ListIndex = -1 Then Exit Sub End If strQualifierName = lstQualifiers.List(lstQualifiers.ListIndex) strQualifierName = Left(strQualifierName, InStr(strQualifierName, Chr(9)) - 1) gppObject.Qualifiers_.Remove (strQualifierName) Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub DelPropertyQualifier(strQualifierName As String) On Error GoTo errorhandler Dim pVal As Variant gppQualSet.Remove strQualifierName gMyPropertyEditor.lstQualifiers.Clear Dim Qualifier As ISWbemQualifier For Each Qualifier In gppQualSet pVal = Qualifier.Value If IsArray(pVal) Then For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If gMyPropertyEditor.lstQualifiers.AddItem Qualifier.Name & Chr(9) & Chr(9) & QualifierType(pVal) & Chr(9) & pVal Next Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub DelMethodQualifier(strQualifierName As String) End Sub Private Sub cmdDerived_Click() Dim mySuperClass As New frmSuperClass mySuperClass.txtSuperClass.Text = gObjectPath mySuperClass.strQRStatus = "Classes" mySuperClass.cmdOK_Click End Sub Private Sub cmdEditMethod_Click() If lstMethods.ListIndex = -1 Then Exit Sub End If Call lstMethods_DblClick End Sub Private Sub cmdEditProp_Click() Call lstProperties_DblClick End Sub Private Sub cmdDelProp_Click() Dim strPropertyName As String On Error GoTo errorhandler strPropertyName = lstProperties.List(lstProperties.ListIndex) strPropertyName = Left(strPropertyName, InStr(strPropertyName, Chr(9)) - 1) gppObject.Properties_.Remove strPropertyName Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Private Sub cmdEditQual_Click() If lstQualifiers.ListIndex = -1 Then Exit Sub End If Call lstQualifiers_DblClick End Sub Private Sub cmdInstances_Click() Dim mySuperClass As New frmSuperClass mySuperClass.txtSuperClass.Text = gObjectPath mySuperClass.strQRStatus = "Instances" mySuperClass.cmdOK_Click End Sub Private Sub cmdRefs_Click() Dim myQuery As New frmQuery strQuery = "Query" myQuery.cmbQueryType.Text = "WQL" myQuery.txtQuery.Text = "references of {" & gObjectPath & "}" myQuery.cmdApply_Click End Sub Private Sub cmdSaveObject_Click() 'Dim pSink As New ObjectSink On Error GoTo errorhandler If Not ParentInObjectEditor Is Nothing Then Set ParentInObjectEditor.MethodInParams = gppObject Unload Me Exit Sub End If If Not ParentOutObjectEditor Is Nothing Then Set ParentOutObjectEditor.MethodOutParams = gppObject Unload Me Exit Sub End If If frmMain.chkAsync.Value = 0 Then gppObject.Put_ Else 'ppNamespace.PutClassAsync gppObject, 0, Nothing, pSink 'While IsEmpty(pSink.status) ' DoEvents 'Wend 'If pSink.status <> 0 Then ' MsgBox ErrorString(pSink.status) 'End If End If If Not ParentQueryResult Is Nothing Then If ParentQueryResult.Visible = True Then Call ParentQueryResult.mySuperClass.cmdOK_Click ParentQueryResult.SetFocus End If End If If IsEmbedded = True Then Set gMyPropertyEditor.tmpObject = gppObject gMyPropertyEditor.txtValue.Text = "" gMyPropertyEditor.txtValue.Enabled = False End If Unload Me Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Private Sub cmdShowMOF_Click() Dim ObjectText As String ObjectText = gppObject.GetObjectText_ frmMOF.txtMOF.Text = ObjectText frmMOF.Show vbModal, frmMain End Sub Private Sub cmdSuperclass_Click() Dim varSuperClass As Variant Dim strSuperClass As String Dim myObjectEditor As New frmObjectEditor Dim Derivation As Variant Derivation = gppObject.Derivation_ strSuperClass = Derivation(UBound(Derivation)) myObjectEditor.GetObject strSuperClass End Sub Public Sub getExecMethod(strMethodName As String) Dim Method As ISWbemMethod Set Method = gppObject.Methods_(strMethodName) Set MethodInParams = Method.InParameters Set MethodOutParams = Method.OutParameters If MethodInParams Is Nothing Then gMyExecMethod.cmdEditIn.Enabled = False gMyExecMethod.cmdClearIn.Enabled = False Else gMyExecMethod.cmdEditIn.Enabled = True gMyExecMethod.cmdClearIn.Enabled = True End If If MethodOutParams Is Nothing Then gMyExecMethod.cmdEditOut.Enabled = False Else gMyExecMethod.cmdEditOut.Enabled = True End If End Sub Private Sub lstMethods_DblClick() Dim pname As String Dim strMethodName As String Dim myMethodEditor As New frmMethodEditor Dim strOriginName As String strMethodName = lstMethods.List(lstMethods.ListIndex) Dim Method As ISWbemMethod Set Method = gppObject.Methods_(strMethodName) Set MethodInParams = Method.InParameters Set MethodOutParams = Method.OutParameters strOriginName = Method.Origin myMethodEditor.txtMethodName.Text = strMethodName myMethodEditor.txtMethodOrigin.Text = strOriginName myMethodEditor.txtMethodName.Enabled = False myMethodEditor.txtMethodName.BackColor = &H8000000F 'Gray myMethodEditor.txtMethodOrigin.Enabled = False If MethodInParams Is Nothing Then myMethodEditor.cmdEditInput.Enabled = False myMethodEditor.chkEnableInput.Value = 0 Else myMethodEditor.cmdEditInput.Enabled = True myMethodEditor.chkEnableInput.Value = 1 End If If MethodOutParams Is Nothing Then myMethodEditor.cmdEditOutput.Enabled = False myMethodEditor.chkEnableOutput.Value = 0 Else myMethodEditor.cmdEditOutput.Enabled = True myMethodEditor.chkEnableOutput.Value = 1 End If Set gppQualSet = Method.Qualifiers_ On Error Resume Next pVal = gppQualSet("not_null").Value If Err.Number = 0 Then myMethodEditor.optNotNull.Value = True Else myMethodEditor.optNormal.Value = True End If On Error GoTo 0 myMethodEditor.lstQualifiers.Clear Dim Qualifier As ISWbemQualifier For Each Qualifier In gppQualSet myMethodEditor.lstQualifiers.AddItem Qualifier.Name & Chr(9) & Chr(9) & QualifierType(Qualifier.Value) & Chr(9) & Qualifier.Value Next Set myMethodEditor.Parent = Me Set gMyMethodEditor = myMethodEditor 'Must be modal to ensure one set of inparams and outparams this object stores when saving the method myMethodEditor.Show vbModal, frmMain End Sub Private Sub lstProperties_DblClick() Dim strPropertyName As String Dim pVal As Variant Dim i As Integer Dim tmpstr As String Dim ppQualSet As ISWbemQualifierSet Dim pname As String Dim strType As String Dim myPropertyEditor As New frmPropertyEditor On Error GoTo errorhandler 'First Clear out old values myPropertyEditor.txtProperty.Text = "" myPropertyEditor.txtOrigin.Text = "" myPropertyEditor.txtValue.Text = "" myPropertyEditor.chkArray.Value = 0 myPropertyEditor.lstQualifiers.Clear 'Disable some boxes since we are editing myPropertyEditor.txtProperty.Enabled = False myPropertyEditor.cmbType.Enabled = False myPropertyEditor.optIndexed.Enabled = True myPropertyEditor.optKey.Enabled = True myPropertyEditor.optNormal.Enabled = True myPropertyEditor.optNotNull2.Enabled = True If lstProperties.ListIndex = -1 Then Exit Sub End If strPropertyName = lstProperties.List(lstProperties.ListIndex) strPropertyName = Left(strPropertyName, InStr(strPropertyName, Chr(9)) - 1) Dim Property As ISWbemProperty On Error Resume Next Set Property = gppObject.Properties_(strPropertyName) If Err <> 0 Then Debug.Print Err.Description End If pVal = Property.Value myPropertyEditor.txtProperty.Text = strPropertyName strType = TypeString(Property.CIMType) myPropertyEditor.cmbType.Text = strType If strType = "CIM_OBJECT" Then myPropertyEditor.cmdView.Visible = True If IsArray(pVal) Then myPropertyEditor.chkArray.Value = 1 End If Else myPropertyEditor.cmdView.Visible = False If IsArray(pVal) Then myPropertyEditor.chkArray.Value = 1 For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If End If If IsNull(pVal) Then myPropertyEditor.optNULL.Value = True myPropertyEditor.cmdView.Enabled = False myPropertyEditor.txtValue.Enabled = False ElseIf strType = "CIM_OBJECT" Then If IsArray(pVal) Then myPropertyEditor.txtValue.Text = "" Else myPropertyEditor.txtValue.Text = "" End If Set myPropertyEditor.tmpObject = pVal myPropertyEditor.optNotNull.Value = True myPropertyEditor.cmdView.Enabled = True myPropertyEditor.txtValue.Enabled = False Else myPropertyEditor.txtValue.Text = pVal myPropertyEditor.optNotNull.Value = True myPropertyEditor.cmdView.Enabled = True myPropertyEditor.txtValue.Enabled = True End If If gObjectPath <> "" Then 'Must not be a new instance myPropertyEditor.txtOrigin.Text = Property.Origin End If 'Now enumerate all property Qualifiers for non-system properties If Mid(strPropertyName, 1, 2) = "__" Then myPropertyEditor.optIndexed.Enabled = False myPropertyEditor.optKey.Enabled = False myPropertyEditor.optNormal.Enabled = False myPropertyEditor.optNotNull2.Enabled = False GoTo skipqualcheck End If Set gppQualSet = Property.Qualifiers_ Dim Qualifier As ISWbemQualifier For Each Qualifier In gppQualSet pVal = Qualifier.Value If IsArray(pVal) Then For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If myPropertyEditor.lstQualifiers.AddItem Qualifier.Name & Chr(9) & Chr(9) & QualifierType(pVal) & Chr(9) & pVal Next skipqualcheck: 'Now fill in the radio buttons myPropertyEditor.optNormal.Value = True On Error Resume Next pVal = Property.Qualifiers_("Key").Value If Err.Number = 0 Then myPropertyEditor.optKey.Value = True End If Err.Number = 0 pVal = Property.Qualifiers_("Indexed").Value If Err.Number = 0 Then myPropertyEditor.optIndexed.Value = True End If Err.Number = 0 pVal = Property.Qualifiers_("not_null").Value If Err.Number = 0 Then myPropertyEditor.optNotNull2.Value = True End If On Error GoTo errorhandler Set myPropertyEditor.Parent = Me myPropertyEditor.Show vbModal, frmMain Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Sub PopulateQualifierDialog(QualifierName As String) Dim pVal As Variant Dim tmpstr As String Dim myQualifierEditor As New frmQualifierEditor Dim isLocal As Boolean Dim isOverridable As Boolean Dim toSubclass As Boolean Dim toInstance As Boolean On Error GoTo errorhandler isLocal = False isOverridable = False toSubclass = False toInstance = False 'First clear out old values myQualifierEditor.txtQualName.Text = "" myQualifierEditor.txtQualValue.Text = "" myQualifierEditor.cmbQualType.Text = "" myQualifierEditor.chkArray.Value = 0 myQualifierEditor.chkDerived.Value = 0 myQualifierEditor.chkInst.Value = 0 myQualifierEditor.chkOverrides.Value = 0 myQualifierEditor.chkPropagated.Value = 0 'Now add info to the dialog myQualifierEditor.txtQualName.Text = QualifierName If QualifierName = "" Then myQualifierEditor.txtQualName.Enabled = True pVal = "" Else myQualifierEditor.txtQualName.Enabled = False Dim Qualifier As ISWbemQualifier Set Qualifier = gppQualSet(QualifierName) pVal = Qualifier.Value isLocal = Qualifier.isLocal isOverridable = Qualifier.isOverridable toSubclass = Qualifier.PropagatesToSubclass toInstance = Qualifier.PropagatesToInstance End If If IsArray(pVal) Then myQualifierEditor.chkArray.Value = 1 For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If myQualifierEditor.cmbQualType.Text = QualifierType(pVal) myQualifierEditor.txtQualValue.Text = pVal 'Origin If (Not isLocal) Then myQualifierEditor.chkPropagated.Value = 1 End If 'Propagation If (toSubclass) Then myQualifierEditor.chkDerived.Value = 1 End If If (toInstance) Then myQualifierEditor.chkInst.Value = 1 End If 'Permissions If (isOverridable) Then myQualifierEditor.chkOverrides.Value = 1 Else myQualifierEditor.chkOverrides.Value = 0 End If Set myQualifierEditor.Parent = Me myQualifierEditor.Show vbModal, frmMain Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Private Sub lstQualifiers_DblClick() Dim QualifierName As String On Error GoTo errorhandler QualifierName = lstQualifiers.List(lstQualifiers.ListIndex) QualifierName = Left(QualifierName, InStr(QualifierName, Chr(9)) - 1) Set gppQualSet = gppObject.Qualifiers_ Call PopulateQualifierDialog(QualifierName) Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub PutProperty(strPropertyName As String, strCIMType As String, inVal As Variant, isKey As Boolean, isIndexed As Boolean, isNotNull As Boolean) Dim pVal As Variant Dim vtType As Long Dim QualSet As ISWbemQualifierSet On Error GoTo errorhandler vtType = StrToType(strCIMType) If IsNull(inVal) Then pVal = Null ElseIf vtType = 13 Then 'if it is an embedded object then use set Set pVal = inVal Else pVal = ConvertText(inVal, vtType) End If Dim Property As ISWbemProperty If InStr(gObjectPath, ".") = 0 Then 'must be a class Set Property = gppObject.Properties_.Add(strPropertyName, vtType) Property.Value = pVal If InStr(1, strPropertyName, "__") = 0 Then Set QualSet = Property.Qualifiers_ If isKey = True Then QualSet.Add "Key", True On Error Resume Next 'Do this in case indexed doesn't exist QualSet.Remove "indexed" QualSet.Remove "not_null" On Error GoTo errorhandler End If If isIndexed = True Then QualSet.Add "indexed", True On Error Resume Next 'Do this in case key doens't exist QualSet.Remove "Key" QualSet.Remove "not_null" On Error GoTo errorhandler End If If isNotNull = True Then QualSet.Add "not_null", True On Error Resume Next 'Do this in case key doens't exist QualSet.Remove "Key" QualSet.Remove "indexed" On Error GoTo errorhandler End If End If Else Set Property = gppObject.Properties_(strPropertyName) Property.Value = pVal End If Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub PutQualifier(strQualifierName As String, strCIMType As String, inVal As Variant, isDerivedToClass As Boolean, isPropagateToInstance As Boolean, isOverridable As Boolean) Dim pVal As Variant Dim vtType As Long On Error GoTo errorhandler If strCIMType = "CIM_STRING" Then pVal = CStr(inVal) ElseIf strCIMType = "CIM_BOOLEAN" Then pVal = CBool(inVal) ElseIf strCIMType = "CIM_SINT32" Then pVal = CInt(inVal) Else pVal = CDbl(inVal) End If gppQualSet.Add strQualifierName, pVal, isDerivedToClass, isPropagatesToInstance, isOverridable If Not gMyPropertyEditor Is Nothing Then gMyPropertyEditor.lstQualifiers.Clear Dim Qualifier As ISWbemQualifier For Each Qualifier In gppQualSet pVal = Qualifier.Value If IsArray(pVal) Then For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If gMyPropertyEditor.lstQualifiers.AddItem Qualifier.Name & Chr(9) & Chr(9) & QualifierType(pVal) & Chr(9) & pVal Next End If If Not gMyMethodEditor Is Nothing Then gMyMethodEditor.lstQualifiers.Clear For Each Qualifier In gppQualSet pVal = Qualifier.Value If IsArray(pVal) Then For i = 0 To UBound(pVal) If i = 0 Then tmpstr = """" & pVal(i) & """" Else tmpstr = tmpstr & "," & """" & pVal(i) & """" End If Next pVal = tmpstr End If gMyMethodEditor.lstQualifiers.AddItem Qualifier.Name & Chr(9) & Chr(9) & QualifierType(pVal) & Chr(9) & pVal Next End If If gMyMethodEditor Is Nothing And gMyPropertyEditor Is Nothing Then Call RefreshLists End If Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub PopulatePropertyQualifierDialog(QualifierName As String, PropertyName As String, myPropertyEditor As frmPropertyEditor) On Error GoTo errorhandler Set gMyPropertyEditor = myPropertyEditor If PropertyName = "" Then MsgBox "Property must be saved before adding qualifiers", vbInformation Exit Sub End If Set gppQualSet = gppObject.Properties_(PropertyName).Qualifiers_ PopulateQualifierDialog (QualifierName) Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub PopulateMethodQualifierDialog(QualifierName As String, MethodName As String, myMethodEditor As frmMethodEditor) On Error GoTo errorhandler Set gMyMethodEditor = myMethodEditor If MethodName = "" Then MsgBox "Method must be saved before adding qualifiers", vbInformation Exit Sub End If Set gppQualSet = gppObject.Methods_(MethodName).Qualifiers_ PopulateQualifierDialog (QualifierName) Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub NewInstance(ClassName As String) Dim Object As ISWbemObject Dim pVal As Variant On Error GoTo errorhandler Set Object = Namespace.Get(ClassName) Set gppObject = Object.SpawnInstance_ gObjectPath = gppObject.Path_.RelPath Call RefreshLists Exit Sub errorhandler: ShowError Err.Number, Err.Description End Sub Public Sub SaveMethod(strMethodName As String, isNotNull As Boolean) End Sub