' Copyright (c) 1997-1999 Microsoft Corporation VERSION 5.00 Begin VB.Form Form1 Caption = "WMI VB PutGet Sample" ClientHeight = 7440 ClientLeft = 60 ClientTop = 345 ClientWidth = 7770 LinkTopic = "Form1" ScaleHeight = 7440 ScaleWidth = 7770 StartUpPosition = 3 'Windows Default Begin VB.CommandButton Command1 Caption = "Put and Get" Height = 495 Left = 2280 TabIndex = 5 Top = 6840 Width = 2655 End Begin VB.OptionButton rdAsynch Caption = "Asynchronous" Height = 255 Left = 0 TabIndex = 4 Top = 7200 Width = 2055 End Begin VB.OptionButton rdSemi Caption = "Semi Synchronus" Height = 255 Left = 0 TabIndex = 3 Top = 6960 Width = 1935 End Begin VB.OptionButton rdSync Caption = "Synchronous" Height = 195 Left = 0 TabIndex = 2 Top = 6720 Width = 1935 End Begin VB.Frame Frame2 Caption = "Get Information" Height = 3015 Left = 0 TabIndex = 1 Top = 3600 Width = 7695 Begin VB.Label lblQualValue BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4200 TabIndex = 53 Top = 2520 Width = 3375 End Begin VB.Label lblQualType BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 2520 TabIndex = 52 Top = 2520 Width = 1575 End Begin VB.Label lblQualName BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 51 Top = 2520 Width = 2295 End Begin VB.Label lblProp2Value BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 4200 TabIndex = 50 Top = 1920 Width = 3375 End Begin VB.Label lblProp2Type BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2520 TabIndex = 49 Top = 1920 Width = 1575 End Begin VB.Label lblProp2Name BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 48 Top = 1920 Width = 2295 End Begin VB.Label lblProp1Value BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 4200 TabIndex = 47 Top = 1320 Width = 3375 End Begin VB.Label lblProp1Type BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2520 TabIndex = 46 Top = 1320 Width = 1575 End Begin VB.Label lblProp1Name BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 45 Top = 1320 Width = 2295 End Begin VB.Label lblClassValue BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 4200 TabIndex = 44 Top = 720 Width = 3375 End Begin VB.Label lblClassType BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2520 TabIndex = 43 Top = 720 Width = 1335 End Begin VB.Label lblClassName BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 42 Top = 720 Width = 2295 End Begin VB.Label Label26 Caption = "Qualifier Value" Height = 255 Left = 4200 TabIndex = 41 Top = 2280 Width = 1335 End Begin VB.Label Label25 Caption = "Qualifier Type" Height = 255 Left = 2520 TabIndex = 40 Top = 2280 Width = 1335 End Begin VB.Label Label24 Caption = "Property2 Value" Height = 255 Left = 4200 TabIndex = 39 Top = 1680 Width = 1575 End Begin VB.Label Label23 Caption = "Property2 Type" Height = 255 Left = 2520 TabIndex = 38 Top = 1680 Width = 1215 End Begin VB.Label Label22 Caption = "Property1 Value" Height = 255 Left = 4200 TabIndex = 37 Top = 1080 Width = 1575 End Begin VB.Label Label21 Caption = "Property1 Type" Height = 255 Left = 2520 TabIndex = 36 Top = 1080 Width = 1215 End Begin VB.Label Label16 Caption = "Class Value" Height = 255 Left = 4200 TabIndex = 31 Top = 480 Width = 1935 End Begin VB.Label Label15 Caption = "Class Type" Height = 255 Left = 2520 TabIndex = 30 Top = 480 Width = 1455 End Begin VB.Label Label8 Caption = "Qualifier Name" Height = 255 Left = 120 TabIndex = 16 Top = 2280 Width = 1215 End Begin VB.Label Label7 Caption = "Property2 Name" Height = 255 Left = 120 TabIndex = 15 Top = 1680 Width = 1335 End Begin VB.Label Label6 Caption = "Property1 Name" Height = 255 Left = 120 TabIndex = 14 Top = 1080 Width = 1335 End Begin VB.Label Label5 Caption = "Class Property Name" Height = 255 Left = 120 TabIndex = 13 Top = 480 Width = 2175 End End Begin VB.Frame Frame1 Caption = "Put Information" Height = 3375 Left = 0 TabIndex = 0 Top = 120 Width = 7695 Begin VB.ComboBox cbProp1Type BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 ItemData = "Form1.frx":0000 Left = 2520 List = "Form1.frx":0002 TabIndex = 29 Text = "CIM_STRING" Top = 1320 Width = 1575 End Begin VB.TextBox txtProp1Name BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 120 TabIndex = 28 Text = "Property1" Top = 1320 Width = 2295 End Begin VB.TextBox txtQualValue BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4200 TabIndex = 27 Text = "Value3" Top = 2760 Width = 3375 End Begin VB.TextBox txtProp2Value BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4200 TabIndex = 26 Text = "Value2" Top = 2040 Width = 3375 End Begin VB.TextBox txtProp1Value BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4200 TabIndex = 25 Text = "Value1" Top = 1320 Width = 3375 End Begin VB.ComboBox cbQualType BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Left = 2520 TabIndex = 21 Text = "CIM_STRING" Top = 2760 Width = 1575 End Begin VB.ComboBox cbProp2Type BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Left = 2520 TabIndex = 20 Text = "CIM_STRING" Top = 2040 Width = 1575 End Begin VB.TextBox txtQualName BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 TabIndex = 12 Text = "Qualifier1" Top = 2760 Width = 2295 End Begin VB.TextBox txtProp2Name BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 TabIndex = 11 Text = "Property2" Top = 2040 Width = 2295 End Begin VB.TextBox txtClassValue BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4200 TabIndex = 10 Text = "MyClass" Top = 600 Width = 3375 End Begin VB.Label Label20 Caption = "CIM_STRING" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2520 TabIndex = 35 Top = 720 Width = 1455 End Begin VB.Label Label19 Caption = "__CLASS" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 34 Top = 720 Width = 1455 End Begin VB.Label Label18 Caption = "Class Type" Height = 255 Left = 2520 TabIndex = 33 Top = 360 Width = 1215 End Begin VB.Label Label17 Caption = "Class Property Name" Height = 255 Left = 120 TabIndex = 32 Top = 360 Width = 1695 End Begin VB.Label Label14 Caption = "Qualifier Value" Height = 255 Left = 4200 TabIndex = 24 Top = 2520 Width = 1335 End Begin VB.Label Label13 Caption = "Property2 Value" Height = 255 Left = 4200 TabIndex = 23 Top = 1800 Width = 1695 End Begin VB.Label Label12 Caption = "Property1 Value" Height = 255 Left = 4200 TabIndex = 22 Top = 1080 Width = 1455 End Begin VB.Label Label11 Caption = "Qualifier Type" Height = 255 Left = 2520 TabIndex = 19 Top = 2520 Width = 1215 End Begin VB.Label Label10 Caption = "Property2 Type" Height = 255 Left = 2520 TabIndex = 18 Top = 1800 Width = 1455 End Begin VB.Label Label9 Caption = "Property1 Type" Height = 255 Left = 2520 TabIndex = 17 Top = 1080 Width = 1335 End Begin VB.Label Label4 Caption = "Qualifier Name" Height = 255 Left = 120 TabIndex = 9 Top = 2520 Width = 1695 End Begin VB.Label Label3 Caption = "Property2 Name" Height = 255 Left = 120 TabIndex = 8 Top = 1800 Width = 1335 End Begin VB.Label Label2 Caption = "Property1 Name" Height = 255 Left = 120 TabIndex = 7 Top = 1080 Width = 1695 End Begin VB.Label Label1 Caption = "Class Value" Height = 255 Left = 4200 TabIndex = 6 Top = 360 Width = 1095 End End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' This code will login to the root\default namespace, and allow the user to add and get a ' user-defined simple class with two properties and one class qualifier. These operations ' can be executed synchronously, semi-synchronously, or asynchronously ' Note--Although no actual pointers are used in WMI APIs for Visual Basic, we still use ' the original hungarian notation used in the COM APIs for the sake of conformity ' (i.e. pp in ppNamespace means pointer to a pointer in C) 'Create a global new DWbemLocator object and assign it to pLocator Dim pLocator As New DWbemLocator 'Create a global reference to a DIWbemServices object, the ConnectServer API call will 'actually create the DIWbemServices object Dim ppNamespace As DIWbemServices 'This sub does most of the work, it does the following: 'Create a new empty class to be used to store properties 'Add properties to the class with the appropriate types 'Put the new class in the database synchronously, semi-synchronously, or asynchronously 'Get the class in the database synchronously, semi-synchronously, or asynchronously 'Display the class on the form Private Sub Command1_Click() 'Create a reference to a DWbemClassObject to be used to put a class Dim putpObject As DWbemClassObject 'Create a reference to a DWbemClassObject to be used to get a class Dim getpObject As DWbemClassObject 'Create a reference to a DIWbemCallResult to be used in Semi-Synchronous functions Dim ppCallResult As DIWbemCallResult 'Create a DIWbemObjectSink Object to be used in Asynchronous functions Dim pResponseHandler As New ObjectSink 'Create a long variable to store Property Types Dim pvtType As Long 'Create a long variable to store Flavor Types Dim plFlavor As Long 'Create a Variant to store Property Values Dim pVal As Variant 'If an error occurs we want to be notified On Error GoTo ErrorHandler 'Check to make sure the class name is populated If txtClassValue.Text = "" Then MsgBox "No Class Value information has been entered", vbCritical Exit Sub End If 'Make sure all property names are filled in If txtProp1Name.Text = "" Then MsgBox "Property 1 Name is empty" Exit Sub End If If txtProp2Name.Text = "" Then MsgBox "Property 2 Name is empty" Exit Sub End If If txtQualName.Text = "" Then MsgBox "Qualifier Name is empty" Exit Sub End If 'Empty out all the labels before starting to put and get new property values 'In the case of an error we don't want old stuff hanging around confusing us. lblClassName.Caption = "" lblClassType.Caption = "" lblClassValue.Caption = "" lblProp1Name.Caption = "" lblProp1Type.Caption = "" lblProp1Value.Caption = "" lblProp2Name.Caption = "" lblProp2Type.Caption = "" lblProp2Value.Caption = "" lblQualName.Caption = "" lblQualType.Caption = "" lblQualValue.Caption = "" 'Use GetObject to create a new empty class object -- use Synchronous since its the simplest ppNamespace.GetObject vbNullString, 0, Nothing, putpObject, Nothing 'Change the __CLASS Property value to contain the name of the class putpObject.Put "__CLASS", 0, txtClassValue.Text, StrToType("CIM_STRING") 'Convert the comboBox and List control texts to appropriate CIM Values pvtType = StrToType(cbProp1Type.Text) pVal = ConvertText(txtProp1Value.Text, pvtType) 'Add the first property putpObject.Put txtProp1Name.Text, 0, pVal, pvtType 'Convert the comboBox and List control texts to appropriate CIM Values pvtType = StrToType(cbProp2Type.Text) pVal = ConvertText(txtProp2Value.Text, pvtType) 'Add the second property putpObject.Put txtProp2Name.Text, 0, pVal, pvtType 'Convert the comboBox and List control texts to appropriate CIM Values pvtType = StrToType(cbQualType.Text) pVal = ConvertText(txtQualValue.Text, pvtType) 'Add the qualifier putpObject.Put txtQualName.Text, 0, pVal, pvtType 'Obviously you can add as many qualifiers, and properties as you would like. 'You can also add property qualifiers here 'Now that we have the class created and populated in memory we need to put it in the 'database 'Put Operations If rdSync.Value = True Then 'If Synchronous is selected then do this 'This call will block until the object has been received ppNamespace.PutClass putpObject, WBEM_RETURN_WHEN_COMPLETE, Nothing, Nothing ElseIf rdSemi.Value = True Then 'If Semi-Synchronous is selected then do this ppNamespace.PutClass putpObject, WBEM_RETURN_IMMEDIATELY, Nothing, ppCallResult While ppCallResult.GetCallStatus(1000, 0) = WBEM_S_PENDING 'Wait till the CallResult object gets the object DoEvents Wend ElseIf rdAsynch.Value = True Then 'If Asyncronous is selected then do this 'Make sure the ObjectSink is all emptied out from any previous async calls pResponseHandler.Status = Empty Set pResponseHandler.pObj = Nothing 'Use PutClassAsync to make the async call, 'Leave the reseverd flag and pContext Null since we don't need either ppNamespace.PutClassAsync putpObject, 0, Nothing, pResponseHandler While IsEmpty(pResponseHandler.Status) 'Wait till the Object Sink gets the object DoEvents 'This VB Call allows other windows events to get processed so the program doesn't appear to hang Wend End If 'Same as above, this example shows how to retrieve a stored class synchronously, semi-synchronously, or asynchronously 'Get Operations If rdSync.Value = True Then 'This call will block until the object has been received ppNamespace.GetObject txtClassValue.Text, WBEM_RETURN_WHEN_COMPLETE, Nothing, getpObject, Nothing ElseIf rdSemi.Value = True Then ppNamespace.GetObject txtClassValue.Text, WBEM_RETURN_IMMEDIATELY, Nothing, Nothing, ppCallResult While ppCallResult.GetCallStatus(1000, 0) = WBEM_S_PENDING 'Wait till the CallResult object gets the object DoEvents Wend ppCallResult.GetResultObject 1000, getpObject ElseIf rdAsynch.Value = True Then 'If Asyncronous is selected then do this 'Make sure the ObjectSink is all emptied out from any previous async calls pResponseHandler.Status = Empty Set pResponseHandler.pObj = Nothing ppNamespace.GetObjectAsync txtClassValue.Text, 0, Nothing, pResponseHandler While IsEmpty(pResponseHandler.Status) DoEvents 'This VB Call allows other windows events to get processed so the program doesn't appear to hang Wend Set getpObject = pResponseHandler.pObj End If 'Now simply get each properties value and populate the labels getpObject.Get "__CLASS", 0, pVal, pvtType, plFlavor lblClassName.Caption = "__CLASS" lblClassType.Caption = TypeString(pvtType) lblClassValue.Caption = CStr(pVal) getpObject.Get txtProp1Name.Text, 0, pVal, pvtType, plFlavor lblProp1Name.Caption = txtProp1Name.Text lblProp1Type.Caption = TypeString(pvtType) lblProp1Value.Caption = CStr(pVal) getpObject.Get txtProp2Name.Text, 0, pVal, pvtType, plFlavor lblProp2Name.Caption = txtProp2Name.Text lblProp2Type.Caption = TypeString(pvtType) lblProp2Value.Caption = CStr(pVal) getpObject.Get txtQualName.Text, 0, pVal, pvtType, plFlavor lblQualName.Caption = txtQualName.Text lblQualType.Caption = TypeString(pvtType) lblQualValue.Caption = CStr(pVal) Exit Sub ErrorHandler: MsgBox "An error has occurred: " & wbemerrorstring(Err.Number) End Sub 'This Sub is called when the form loads, it logs the client into the root\default namespace 'This Sub also loads the CIM Types into the combo boxes Private Sub Form_Load() 'If an error occurs we want to be notified On Error GoTo ErrorHandler 'Pass in "root\default" to login to the root\default namespace. 'Pass vbNullstring for the username, password, locale and authority since we want to use the 'currently logged in user, password and we want the default locale and authority 'Flags are set to zero since only NTLM security is used with WMI. 'Pass Nothing for Context since we don't need to use it in this example. 'Pass in ppNamespace as the only out parameter. pLocator.ConnectServer "root\default", vbNullString, vbNullString, vbNullString, 0, vbNullString, Nothing, ppNamespace cbProp1Type.AddItem "CIM_STRING" cbProp1Type.AddItem "CIM_BOOLEAN" cbProp1Type.AddItem "CIM_REAL32" cbProp1Type.AddItem "CIM_SINT8" cbProp1Type.AddItem "CIM_SINT16" cbProp1Type.AddItem "CIM_UINT8" cbProp1Type.AddItem "CIM_UINT16" cbProp2Type.AddItem "CIM_STRING" cbProp2Type.AddItem "CIM_BOOLEAN" cbProp2Type.AddItem "CIM_REAL32" cbProp2Type.AddItem "CIM_SINT8" cbProp2Type.AddItem "CIM_SINT16" cbProp2Type.AddItem "CIM_UINT8" cbProp2Type.AddItem "CIM_UINT16" cbQualType.AddItem "CIM_STRING" cbQualType.AddItem "CIM_BOOLEAN" cbQualType.AddItem "CIM_REAL32" cbQualType.AddItem "CIM_SINT8" cbQualType.AddItem "CIM_SINT16" cbQualType.AddItem "CIM_UINT8" cbQualType.AddItem "CIM_UINT16" Exit Sub ErrorHandler: MsgBox "An error has occurred loading the form: " & wbemerrorstring(Err.Number) End Sub 'This function takes a long error code and converts it into a more understandable error string 'This information is found in the WMI Header files Private Function wbemerrorstring(ErrorNumber As Long) As String Dim str As String Select Case ErrorNumber Case WBEM_NO_ERROR str = "WBEM_NO_ERROR" Case WBEM_E_ACCESS_DENIED str = "WBEM_E_ACCESS_DENIED" Case WBEM_E_ALREADY_EXISTS str = "WBEM_E_ALREADY_EXISTS" Case WBEM_E_CANNOT_BE_KEY str = "WBEM_E_CANNOT_BE_KEY" Case WBEM_E_CANNOT_BE_SINGLETON str = "WBEM_E_CANNOT_BE_SINGLETON" Case WBEM_E_CLASS_HAS_CHILDREN str = "WBEM_E_CLASS_HAS_CHILDREN" Case WBEM_E_CLASS_HAS_INSTANCES str = "WBEM_E_CLASS_HAS_INSTANCES" Case WBEM_E_CRITICAL_ERROR str = "WBEM_E_CRITICAL_ERROR" Case WBEM_E_FAILED str = "WBEM_E_FAILED" Case WBEM_E_ILLEGAL_NULL str = "WBEM_E_ILLEGAL_NULL" Case WBEM_E_ILLEGAL_OPERATION str = "WBEM_E_ILLEGAL_OPERATION" Case WBEM_E_INCOMPLETE_CLASS str = "WBEM_E_INCOMPLETE_CLASS" Case WBEM_E_INITIALIZATION_FAILURE str = "WBEM_E_INITIALIZATION_FAILURE" Case WBEM_E_INVALID_CIM_TYPE str = "WBEM_E_INVALID_CIM_TYPE" Case WBEM_E_INVALID_CLASS str = "WBEM_E_INVALID_CLASS" Case WBEM_E_INVALID_CONTEXT str = "WBEM_E_INVALID_CONTEXT" Case WBEM_E_INVALID_METHOD str = "WBEM_E_INVALID_METHOD" Case WBEM_E_INVALID_METHOD_PARAMETERS str = "WBEM_E_INVALID_METHOD_PARAMETERS" Case WBEM_E_INVALID_NAMESPACE str = "WBEM_E_INVALID_NAMESPACE" Case WBEM_E_INVALID_OBJECT str = "WBEM_E_INVALID_OBJECT" Case WBEM_E_INVALID_OPERATION str = "WBEM_E_INVALID_OPERATION" Case WBEM_E_INVALID_PARAMETER str = "WBEM_E_INVALID_PARAMETER" Case WBEM_E_INVALID_PROPERTY_TYPE str = "WBEM_E_INVALID_PROPERTY_TYPE" Case WBEM_E_INVALID_PROVIDER_REGISTRATION str = "WBEM_E_INVALID_PROVIDER_REGISTRATION" Case WBEM_E_INVALID_QUALIFIER_TYPE str = "WBEM_E_INVALID_QUALIFIER_TYPE" Case WBEM_E_INVALID_QUERY str = "WBEM_E_INVALID_QUERY" Case WBEM_E_INVALID_QUERY_TYPE str = "WBEM_E_INVALID_QUERY_TYPE" Case WBEM_E_INVALID_STREAM str = "WBEM_E_INVALID_STREAM" Case WBEM_E_INVALID_SUPERCLASS str = "WBEM_E_INVALID_SUPERCLASS" Case WBEM_E_INVALID_SYNTAX str = "WBEM_E_INVALID_SYNTAX" Case WBEM_E_NONDECORATED_OBJECT str = "WBEM_E_NONDECORATED_OBJECT" Case WBEM_E_NOT_AVAILABLE str = "WBEM_E_NOT_AVAILABLE" Case WBEM_E_NOT_FOUND str = "WBEM_E_NOT_FOUND" Case WBEM_E_NOT_SUPPORTED str = "WBEM_E_NOT_SUPPORTED" Case WBEM_E_OUT_OF_MEMORY str = "WBEM_E_OUT_OF_MEMORY" Case WBEM_E_OVERRIDE_NOT_ALLOWED str = "WBEM_E_OVERRIDE_NOT_ALLOWED" Case WBEM_E_PROPAGATED_PROPERTY str = "WBEM_E_PROPAGATED_PROPERTY" Case WBEM_E_PROPAGATED_QUALIFIER str = "WBEM_E_PROPAGATED_QUALIFIER" Case WBEM_E_PROVIDER_FAILURE str = "WBEM_E_PROVIDER_FAILURE" Case WBEM_E_PROVIDER_LOAD_FAILURE str = "WBEM_E_PROVIDER_LOAD_FAILURE" Case WBEM_E_PROVIDER_NOT_CAPABLE str = "WBEM_E_PROVIDER_NOT_CAPABLE" Case WBEM_E_PROVIDER_NOT_FOUND str = "WBEM_E_PROVIDER_NOT_FOUND" Case WBEM_E_QUERY_NOT_IMPLEMENTED str = "WBEM_E_QUERY_NOT_IMPLEMENTED" Case WBEM_E_READ_ONLY str = "WBEM_E_READ_ONLY" Case WBEM_E_TRANSPORT_FAILURE str = WBEM_E_TRANSPORT_FAILURE Case WBEM_E_TYPE_MISMATCH str = "WBEM_E_TYPE_MISMATCH" Case WBEM_E_UNEXPECTED str = "WBEM_E_UNEXPECTED" Case WBEM_E_VALUE_OUT_OF_RANGE str = "WBEM_E_VALUE_OUT_OF_RANGE" Case WBEM_S_ALREADY_EXISTS str = "WBEM_S_ALREADY_EXISTS" Case WBEM_S_DIFFERENT str = "WBEM_S_DIFFERENT" Case WBEM_S_FALSE str = "WBEM_S_FALSE" Case WBEM_S_LOGIN str = "WBEM_S_LOGIN" Case WBEM_S_NO_ERROR str = "WBEM_S_NO_ERROR" Case WBEM_S_NO_MORE_DATA str = "WBEM_S_NO_MORE_DATA" Case WBEM_S_OPERATION_CANCELED str = "WBEM_S_OPERATION_CANCELED" Case WBEM_S_PENDING str = "WBEM_S_PENDING" Case WBEM_S_PRELOGIN str = "WBEM_S_PRELOGIN" Case WBEM_S_RESET_TO_DEFAULT str = "WBEM_S_RESET_TO_DEFAULT" Case WBEM_S_SAME str = "WBEM_S_SAME" Case WBEM_S_TIMEDOUT str = "WBEM_S_TIMEDOUT" Case WBEMESS_E_REGISTRATION_TOO_BROAD str = "WBEMESS_E_REGISTRATION_TOO_BROAD" Case WBEMESS_E_REGISTRATION_TOO_PRECISE str = "WBEMESS_E_REGISTRATION_TOO_PRECISE" Case -2147023174 str = "The RPC Server is Unavailable" Case Else str = "Unknown WMI Error: " & iErr End Select wbemerrorstring = Err.Description & Chr(13) & str End Function 'This funciton takes a long and converts it into the CIM string representation of its value Public Function TypeString(lngCIMType As Long) As String Dim baseType As Long baseType = lngCIMType And Not 8192 'take out the array flag Select Case baseType Case 0 TypeString = "CIM_EMPTY" Case 2 TypeString = "CIM_SINT16" Case 3 TypeString = "CIM_SINT32" Case 4 TypeString = "CIM_REAL32" Case 5 TypeString = "CIM_REAL64" Case 8 TypeString = "CIM_STRING" Case 11 TypeString = "CIM_BOOLEAN" Case 13 TypeString = "CIM_OBJECT" Case 16 TypeString = "CIM_SINT8" Case 17 TypeString = "CIM_UINT8" Case 18 TypeString = "CIM_UINT16" Case 19 TypeString = "CIM_UINT32" Case 20 TypeString = "CIM_SINT64" Case 21 TypeString = "CIM_UINT64" Case 101 TypeString = "CIM_DATETIME" Case 102 TypeString = "CIM_REFERENCE" Case 103 TypeString = "CIM_CHAR16" Case 8192 TypeString = "CIM_FLAG_ARRAY" Case 8200 TypeString = "CIM_ARRAY|CIM_STRING" Case 4095 TypeString = "CIM_ILLEGAL" Case Else TypeString = "Type " & lngCIMType & " is unknown" End Select If lngCIMType And 8192 Then TypeString = TypeString & "|CIM_ARRAY" End If End Function 'This Function takes a CIM String Type and converts it into its specific Long Value Public Function StrToType(CIMString As String) As Long If UCase(CIMString) = "CIM_ILLEGAL" Then StrToType = 4095 ElseIf UCase(CIMString) = "CIM_EMPTY" Then StrToType = 0 ElseIf UCase(CIMString) = "CIM_SINT8" Then StrToType = 16 ElseIf UCase(CIMString) = "CIM_UINT8" Then StrToType = 17 ElseIf UCase(CIMString) = "CIM_SINT16" Then StrToType = 2 ElseIf UCase(CIMString) = "CIM_UINT16" Then StrToType = 18 ElseIf UCase(CIMString) = "CIM_SINT32" Then StrToType = 3 ElseIf UCase(CIMString) = "CIM_UINT32" Then StrToType = 19 ElseIf UCase(CIMString) = "CIM_SINT64" Then StrToType = 20 ElseIf UCase(CIMString) = "CIM_UINT64" Then StrToType = 21 ElseIf UCase(CIMString) = "CIM_REAL32" Then StrToType = 4 ElseIf UCase(CIMString) = "CIM_REAL64" Then StrToType = 5 ElseIf UCase(CIMString) = "CIM_BOOLEAN" Then StrToType = 11 ElseIf UCase(CIMString) = "CIM_STRING" Then StrToType = 8 ElseIf UCase(CIMString) = "CIM_DATETIME" Then StrToType = 101 ElseIf UCase(CIMString) = "CIM_REFERENCE" Then StrToType = 102 ElseIf UCase(CIMString) = "CIM_CHAR16" Then StrToType = 103 ElseIf UCase(CIMString) = "CIM_OBJECT" Then StrToType = 13 ElseIf UCase(CIMString) = "CIM_FLAG_ARRAY" Then StrToType = 8192 Else: StrToType = 4095 'CIM_ILLEGAL End If End Function 'This function takes a vb String and converts it into the appropriate type to be inserted into CIM Function ConvertText(txtString As String, CIMType As Long) As Variant Select Case CIMType Case 0 ConvertText = "" Case 2, 16 ConvertText = CInt(txtString) Case 4 ConvertText = CSng(txtString) Case 3, 5, 18, 19 To 21 ConvertText = CLng(txtString) Case 8, 101 ConvertText = CStr(txtString) Case 11 ConvertText = CBool(txtString) Case 13, 101, 102, 103 ConvertText = CVar(txtString) Case 17 ConvertText = CByte(txtString) Case Else ConvertText = CVar(txtString) End Select End Function