home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 Special / chip-cd_2001_spec_05.zip / spec_05 / ras.cab / query.vbs < prev    next >
Text File  |  1999-11-04  |  40KB  |  1,049 lines
  1. '********************************************************************
  2. '*
  3. '* File:           Query.vbs
  4. '* Created:        March 1999
  5. '* Version:        1.0
  6. '*
  7. '*  Main Function:  Performs a general WBEM query.
  8. '*
  9. '*
  10. '* Copyright (C) 1999 Microsoft Corporation
  11. '*
  12. '********************************************************************
  13.  
  14.  
  15.     OPTION EXPLICIT
  16.  
  17.     'Define constants
  18.     CONST CONST_ERROR                   = 0
  19.     CONST CONST_WSCRIPT                 = 1
  20.     CONST CONST_CSCRIPT                 = 2
  21.     CONST CONST_SHOW_USAGE              = 3
  22.     CONST CONST_PROCEED                 = 4
  23.     CONST CONST_SORT_NO                 = 5
  24.     CONST CONST_SORT_ASCENDING          = 6
  25.     CONST CONST_SORT_DESCENDING         = 7
  26.  
  27.     'Declare variables
  28.     Dim intOpMode, i, intSortOrder, intSortProperty
  29.     Dim strServer, strNameSpace, intWidth, strClass, strCriteria
  30.     Dim strOutputFile, strUserName, strPassword
  31.     Dim blnListProperties, blnFlush
  32.     ReDim strArgumentArray(0), strProperties(0), intWidths(0)
  33.  
  34.     'Initialize variables
  35.     strServer = ""
  36.     strNameSpace = "root\cimv2"
  37.     intWidth = 15
  38.     strClass = ""
  39.     strCriteria = ""
  40.     intSortOrder = CONST_SORT_ASCENDING   'Sort-ascending by default.
  41.     intSortProperty = 1                   'Sort according to the first property.
  42.     strOutputFile = ""
  43.     strUserName = ""
  44.     strPassword = ""
  45.     blnFlush = False
  46.     blnListProperties = False
  47.     strArgumentArray(0) = ""
  48.     strProperties(0) = "*"
  49.     intWidths(0) = 0
  50.  
  51.     'Get the command line arguments
  52.     For i = 0 to WScript.arguments.count - 1
  53.         ReDim Preserve strArgumentArray(i)
  54.         strArgumentArray(i) = WScript.arguments.Item(i)
  55.     Next
  56.  
  57.     'Check whether the script is run using CScript
  58.     Select Case intChkProgram()
  59.         Case CONST_CSCRIPT
  60.             'Do Nothing
  61.         Case CONST_WSCRIPT
  62.             WScript.Echo "Please run this script using CScript." & vbCRLF & _
  63.                 "This can be achieved by" & vbCRLF & _
  64.                 "1. Using ""CScript QUERY.VBS arguments"" for Windows 95/98 or" & vbCRLF & _
  65.                 "2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
  66.                 "    using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
  67.                 "    ""QUERY.VBS arguments"" for Windows NT."
  68.             WScript.Quit
  69.         Case Else
  70.             WScript.Quit
  71.     End Select
  72.  
  73.     'Parse the command line
  74.     intOpMode = intParseCmdLine(strArgumentArray, strServer, strNameSpace, strProperties, _
  75.                 intWidths, intWidth, strClass, strCriteria, intSortOrder, intSortProperty, _
  76.                 strOutputFile, strUserName, strPassword, blnListProperties, blnFlush)
  77.     If Err.Number then
  78.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
  79.         If Err.Description <> "" Then
  80.             Print "Error description: " & Err.Description & "."
  81.         End If
  82.         WScript.Quit
  83.     End If
  84.  
  85.     Select Case intOpMode
  86.         Case CONST_SHOW_USAGE
  87.             Call ShowUsage()
  88.         Case CONST_PROCEED
  89.             Call Query(strServer, strNameSpace, strProperties, intWidths, intWidth, _
  90.                  strClass, strCriteria, intSortOrder, intSortProperty, strOutputFile, _
  91.                  strUserName, strPassword, blnListProperties, blnFlush)
  92.         Case CONST_ERROR
  93.             'Do nothing.
  94.         Case Else                    'Default -- should never happen
  95.             Print "Error occurred in passing parameters."
  96.     End Select
  97.  
  98. '********************************************************************
  99. '*
  100. '* Function intChkProgram()
  101. '* Purpose: Determines which program is used to run this script.
  102. '* Input:   None
  103. '* Output:  intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
  104. '*          and CONST_CSCRIPT.
  105. '*
  106. '********************************************************************
  107.  
  108. Private Function intChkProgram()
  109.  
  110.     ON ERROR RESUME NEXT
  111.  
  112.     Dim strFullName, strCommand, i, j
  113.  
  114.     'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
  115.     strFullName = WScript.FullName
  116.     If Err.Number then
  117.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
  118.         If Err.Description <> "" Then
  119.             If Err.Description <> "" Then
  120.                 Print "Error description: " & Err.Description & "."
  121.             End If
  122.         End If
  123.         intChkProgram =  CONST_ERROR
  124.         Exit Function
  125.     End If
  126.  
  127.     i = InStr(1, strFullName, ".exe", 1)
  128.     If i = 0 Then
  129.         intChkProgram =  CONST_ERROR
  130.         Exit Function
  131.     Else
  132.         j = InStrRev(strFullName, "\", i, 1)
  133.         If j = 0 Then
  134.             intChkProgram =  CONST_ERROR
  135.             Exit Function
  136.         Else
  137.             strCommand = Mid(strFullName, j+1, i-j-1)
  138.             Select Case LCase(strCommand)
  139.                 Case "cscript"
  140.                     intChkProgram = CONST_CSCRIPT
  141.                 Case "wscript"
  142.                     intChkProgram = CONST_WSCRIPT
  143.                 Case Else       'should never happen
  144.                     Print "An unexpected program is used to run this script."
  145.                     Print "Only CScript.Exe or WScript.Exe can be used to run this script."
  146.                     intChkProgram = CONST_ERROR
  147.             End Select
  148.         End If
  149.     End If
  150.  
  151. End Function
  152.  
  153. '********************************************************************
  154. '*
  155. '* Function intParseCmdLine()
  156. '* Purpose: Parses the command line.
  157. '* Input:   strArgumentArray    an array containing input from the command line
  158. '* Output:  strServer           a machine name
  159. '*          strNameSpace        a namespace string
  160. '*          strProperties       an array containing names of properties to be retrieved
  161. '*          intWidths           an array containing the width of columns used to display
  162. '*                              values of the corresponding properties
  163. '*          intWidth            the default column width
  164. '*          strClass            a class name
  165. '*          strCriteria         the query criteria
  166. '*          intWidth            the default column width
  167. '*          intSortOrder        specifies the sort order (ascend/descend/none)
  168. '*          intSortProperty     specifies a property according to which the results
  169. '*                              will be sorted
  170. '*          strOutputFile       an output file name
  171. '*          strUserName         the current user's name
  172. '*          strPassword         the current user's password
  173. '*          blnListProperties   specifies whether to list properties available
  174. '*          blnFlush            specifies whether to use flush output
  175. '*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
  176. '*
  177. '********************************************************************
  178.  
  179. Private Function intParseCmdLine(strArgumentArray, strServer, strNameSpace, strProperties, intWidths, _
  180.     intWidth, strClass, strCriteria, intSortOrder, intSortProperty, strOutputFile, _
  181.     strUserName, strPassword, blnListProperties, blnFlush)
  182.  
  183.     ON ERROR RESUME NEXT
  184.  
  185.     Dim strFlag, i, j, intColon, strSort
  186.  
  187.     strFlag = strArgumentArray(0)
  188.  
  189.     If strFlag = "" then                'No arguments have been received
  190.         Print "Arguments are required."
  191.         intParseCmdLine = CONST_ERROR
  192.         Exit Function
  193.     End If
  194.  
  195.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  196.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
  197.         intParseCmdLine = CONST_SHOW_USAGE
  198.         Exit Function
  199.     End If
  200.  
  201.     j = 0
  202.     For i = 0 to UBound(strArgumentArray)
  203.         strFlag = LCase(Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1))
  204.         If Err.Number Then            'An error occurs if there is no : in the string
  205.             Err.Clear
  206.             Select Case LCase(strArgumentArray(i))
  207.                 Case "/f"
  208.                     blnFlush = True                 'Flush output
  209.                 Case "/p"
  210.                     blnListProperties = True        'lists available properties
  211.                 Case Else
  212.                     Print strArgumentArray(i) & " is not a valid input."
  213.                     Print "Please check the input and try again."
  214.                     intParseCmdLine = CONST_ERROR
  215.                     Exit Function
  216.             End Select
  217.         Else
  218.             Select Case strFlag
  219.                 Case "/s"
  220.                     strServer = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  221.                 Case "/n"
  222.                     strNameSpace = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  223.                 Case "/d"
  224.                     intWidth = CInt(Right(strArgumentArray(i), Len(strArgumentArray(i))-3))
  225.                     If Err.Number Then
  226.                         Print "Please enter an integer for the width of a column."
  227.                         Err.Clear
  228.                         intParseCmdLine = CONST_ERROR
  229.                         Exit Function
  230.                     End If
  231.                 Case "/p"
  232.                     ReDim Preserve strProperties(j), intWidths(j)
  233.                     'Get the string to the right of :
  234.                     strProperties(j) = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  235.                     intColon = InStr(1, strProperties(j), ":")
  236.                     If intColon <> 0 Then       'There is a : in strProperties(j)
  237.                         intWidths(j) = CInt(Right(strProperties(j), Len(strProperties(j))-intColon))
  238.                         If Err.Number Then
  239.                             Print Right(strProperties(j), Len(strProperties(j))-intColon) & _
  240.                                 " is not an integer!"
  241.                             Print "Please check the input and try again."
  242.                             Err.Clear
  243.                             intParseCmdLine = CONST_ERROR
  244.                             Exit Function
  245.                         End If
  246.                         strProperties(j) = Left(strProperties(j), intColon-1)
  247.                     Else    'There is no colon in the string.
  248.                         intWidths(j) = intWidth          'The default.
  249.                     End If
  250.                     j = j + 1
  251.                 Case "/from"
  252.                     strClass = Right(strArgumentArray(i), Len(strArgumentArray(i))-6)
  253.                 Case "/where"
  254.                     strCriteria = Right(strArgumentArray(i), Len(strArgumentArray(i))-7)
  255.                 Case "/sort"
  256.                     'Get the string to the right of /sort:
  257.                     strSort = Right(strArgumentArray(i), Len(strArgumentArray(i))-6)
  258.                     intColon = InStr(1, strSort, ":")
  259.                     If intColon <> 0 Then    'There is a colon in the string.
  260.                         intSortProperty = CInt(Right(strSort, Len(strSort)-intColon))
  261.                         If Err.Number Then
  262.                             Print Right(strSort, Len(strSort)-intColon) & " is not an integer!"
  263.                             Print "Please check the input and try again."
  264.                             Err.Clear
  265.                             intParseCmdLine = CONST_ERROR
  266.                             Exit Function
  267.                         End If
  268.                         strSort = LCase(Left(strSort, intColon-1))
  269.                     End If
  270.                     Select Case strSort
  271.                         Case "a"
  272.                             intSortOrder = CONST_SORT_ASCENDING
  273.                         Case "d"
  274.                             intSortOrder = CONST_SORT_DESCENDING
  275.                         Case "n"
  276.                             intSortOrder = CONST_SORT_NO
  277.                         Case Else
  278.                             Print "Invalid sorting option: " & strSort & "."
  279.                             Print "Please check the input and try again."
  280.                             intParseCmdLine = CONST_ERROR
  281.                             Exit Function
  282.                     End Select
  283.                 Case "/o"
  284.                     strOutputFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  285.                 Case "/u"
  286.                     strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  287.                 Case "/w"
  288.                     strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  289.                 Case else
  290.                     Print "Invalid flag " & """" & strFlag & ":""" & "."
  291.                     Print "Please check the input and try again."
  292.                     intParseCmdLine = CONST_ERROR
  293.                     Exit Function
  294.                 End Select
  295.         End If
  296.     Next
  297.  
  298.     intParseCmdLine = CONST_PROCEED
  299.  
  300.     If strClass = "" Then
  301.         Print "Please enter the name of a class using /FROM:class."
  302.         intParseCmdLine = CONST_ERROR
  303.     End If
  304.  
  305. End Function
  306.  
  307. '********************************************************************
  308. '*
  309. '* Sub ShowUsage()
  310. '* Purpose: Shows the correct usage to the user.
  311. '* Input:   None
  312. '* Output:  Help messages are displayed on screen.
  313. '*
  314. '********************************************************************
  315.  
  316. Private Sub ShowUsage()
  317.  
  318.     WScript.Echo ""
  319.     WScript.Echo "Performs a general WBEM query." & vbCRLF
  320.     WScript.Echo "1. QUERY.VBS [/S:server]  [/N:namespace] [/P:property1[:width1]"
  321.     WScript.Echo "   [/P:property2[:width2]]...] [/D:width] /FROM:class"
  322.     WScript.Echo "   [/WHERE:criteria] [/SORT:A | D[:num] | N] [/O:outputfile]"
  323.     WScript.Echo "   [/U:username] [/W:password] [/F]"
  324.     WScript.Echo "2. QUERY.VBS [/S:server]  [/N:namespace] /FROM:class [/O:outputfile]"
  325.     WScript.Echo "   [/U:username] [/W:password] [/P]"
  326.     WScript.Echo "   /S, /N, /P, /FROM, /WHERE, /SORT, /O, /D, /U, /W"
  327.     WScript.Echo "                 Parameter specifiers."
  328.     WScript.Echo "   server        A machine name."
  329.     WScript.Echo "   namespace     A namespace. The default is ""root\cimv2""."
  330.     WScript.Echo "   property1, property2 ..."
  331.     WScript.Echo "                 Names of properties to be retrieved."
  332.     WScript.Echo "   width1, width2..."
  333.     WScript.Echo "                 Widths of columns used to display values of the "
  334.     WScript.Echo "                 corresponding properties."
  335.     WScript.Echo "   width         Default column width."
  336.     WScript.Echo "   class         A class name."
  337.     WScript.Echo "   conditions    Query conditions."
  338.     WScript.Echo "   A | D | N     A  ascending  D  descending  N  no sorting."
  339.     WScript.Echo "   num           An integer. For example, 1 specifies sorting results"
  340.     WScript.Echo "                 according to the first property specified using /P:"
  341.     WScript.Echo "   outputfile    The output file name."
  342.     WScript.Echo "   username      The current user's name."
  343.     WScript.Echo "   password      Password of the current user."
  344.     WScript.Echo "   /P            Lists the names of all available properties of a job."
  345.     WScript.Echo "   /F            Flush output. Output strings are truncated if needed." & vbCRLF
  346.     WScript.Echo "EXAMPLE:"
  347.     WScript.Echo "1. QUERY.VBS /S:MyMachine2 /P:Name:15 /P:ProcessId:15 /SORT:A:2"
  348.     WScript.Echo "   /FROM:Win32_Process /where:""processid>100"""
  349.     WScript.Echo "   lists the names and process ids of jobs currently running on"
  350.     WScript.Echo "   MyMachine2 with a process id larger than 100 and sorts the result"
  351.     WScript.Echo "   so the process ids are listed in an ascending order."
  352.     WScript.Echo "2. QUERY.VBS /S:MyMachine2 /FROM:Win32_Process /P"
  353.     WScript.Echo "   lists the names of all available properties of win32_process."
  354.  
  355. End Sub
  356.  
  357. '********************************************************************
  358. '*
  359. '* Sub Query()
  360. '* Purpose: Performs a general WBEM query.
  361. '* Input:   strServer           a machine name
  362. '*          strNameSpace        a namespace string
  363. '*          strProperties       an array containing names of properties to be retrieved
  364. '*          intWidths           an array containing the width of columns used to display
  365. '*                              values of the corresponding properties
  366. '*          intWidth            the default column width
  367. '*          strClass            a class name
  368. '*          strCriteria         the query criteria
  369. '*          intWidth            the default column width
  370. '*          intSortOrder        specifies the sort order (ascend/descend/none)
  371. '*          intSortProperty     specifies a property according to which the results
  372. '*                              will be sorted
  373. '*          strOutputFile       an output file name
  374. '*          strUserName         the current user's name
  375. '*          strPassword         the current user's password
  376. '*          blnListProperties   specifies whether to list properties available
  377. '*          blnFlush            specifies whether to use flush output
  378. '* Output:  Results are either printed on screen or saved in strOutputFile.
  379. '*
  380. '********************************************************************
  381.  
  382. Private Sub Query(strServer, strNameSpace, strProperties, intWidths, intWidth, _
  383.     strClass, strCriteria, intSortOrder, intSortProperty, strOutputFile, _
  384.     strUserName, strPassword, blnListProperties, blnFlush)
  385.  
  386.     ON ERROR RESUME NEXT
  387.  
  388.     Dim objFileSystem, objOutputFile, objService, blnAll, strQuery, strMessage, i, j
  389.     ReDim strPropertyTypes(0)
  390.  
  391.     If strProperties(0) = "*" Then
  392.         blnAll = True
  393.     Else
  394.         blnAll = False
  395.     End If
  396.  
  397.     If strOutputFile = "" Then
  398.         objOutputFile = ""
  399.     Else
  400.         'Create a file object
  401.         set objFileSystem = CreateObject("Scripting.FileSystemObject")
  402.         If Err.Number then
  403.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
  404.             If Err.Description <> "" Then
  405.                 Print "Error description: " & Err.Description & "."
  406.             End If
  407.             Exit Sub
  408.         End If
  409.         'Open the file for output
  410.         set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True)
  411.         If Err.Number then
  412.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile
  413.             If Err.Description <> "" Then
  414.                 Print "Error description: " & Err.Description & "."
  415.             End If
  416.             Exit Sub
  417.         End If
  418.     End If
  419.  
  420.     'Establish a connection with the server.
  421.     If blnConnect(objService, strServer, strNameSpace, strUserName, strPassword) Then
  422.         Call Wscript.Echo("")
  423.         Call Wscript.Echo("Please check the server name, credentials and WBEM Core.")
  424.         Exit Sub
  425.     End If
  426.  
  427.     If blnListProperties or blnAll Then
  428.         'Get all available properties
  429.         Call blnGetAllProperties(objService, strClass, strProperties, strPropertyTypes)
  430.     End If
  431.  
  432.     If blnListProperties Then
  433.         'Print the available properties on screen
  434.         strMessage = vbCRLF & "Available properties of " & strClass & ":"
  435.         WriteLine strMessage & vbCRLF, objOutputFile
  436.         strMessage = strPackString("PROPERTY NAME", 30, 1, 0)
  437.         strMessage = strMessage & strPackString("CIMTYPE", 20, 1, 0)
  438.         WriteLine strMessage & vbCRLF, objOutputFile
  439.         For i = 0 To UBound(strProperties)
  440.             strMessage = strPackString(strProperties(i), 30, 1, 0)
  441.             strMessage = strMessage & strPackString(strPropertyTypes(i), 20, 1, 0)
  442.             WriteLine strMessage, objOutputFile
  443.         Next
  444.     Else
  445.         If blnAll Then
  446.             'Expand intWidths
  447.             j = UBound(strProperties)
  448.             ReDim intWidths(j)
  449.             For i = 0 To j
  450.                 intWidths(i) = intWidth
  451.             Next
  452.         End If
  453.  
  454.         If (intSortProperty > UBound(strProperties)+1) Then
  455.             Print intSortProperty & " is larger than the number of properties to be retrieved."
  456.             Print "Only " & UBound(strProperties)+1 & " properties are available."
  457.             Print "Please check the input and try again."
  458.             Exit Sub
  459.         End If
  460.  
  461.         'Set the query string.
  462.         If blnAll Then
  463.             strQuery = "Select *"
  464.         Else
  465.             strQuery = "Select "
  466.             For i = 0 To UBound(strProperties)-1
  467.                 strQuery = strQuery & LCase(strProperties(i)) & ", "
  468.             Next
  469.             strQuery = strQuery & LCase(strProperties(i))
  470.         End If
  471.         strQuery = strQuery & " From " & strClass
  472.  
  473.         If strCriteria <> "" Then
  474.             strQuery = strQuery & " Where " & strCriteria
  475.         End If
  476.  
  477.         'Now execute the query.
  478.         Call ExecuteQuery(objService, strQuery, strProperties, intWidths, _
  479.              intSortProperty, intSortOrder, blnFlush, objOutputFile)
  480.     End If
  481.  
  482.     If strOutputFile <> "" Then
  483.         objOutputFile.Close
  484.         WScript.Echo "Results are saved in file " & strOutputFile & "."
  485.     End If
  486.  
  487. End Sub
  488.  
  489. '********************************************************************
  490. '*
  491. '* Function blnConnect()
  492. '* Purpose: Connects to machine strServer.
  493. '* Input:   strServer       a machine name
  494. '*          strNameSpace    a namespace
  495. '*          strUserName     name of the current user
  496. '*          strPassword     password of the current user
  497. '* Output:  objService is returned  as a service object.
  498. '*
  499. '********************************************************************
  500.  
  501. Private Function blnConnect(objService, strServer, strNameSpace, strUserName, strPassword)
  502.  
  503.     ON ERROR RESUME NEXT
  504.  
  505.     Dim objLocator
  506.  
  507.     blnConnect = False     'There is no error.
  508.  
  509.     ' Create Locator object to connect to remote CIM object manager
  510.     Set objLocator = CreateObject("WbemScripting.SWbemLocator")
  511.     If Err.Number then
  512.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating a locator object."
  513.         If Err.Description <> "" Then
  514.             Print "Error description: " & Err.Description & "."
  515.         End If
  516.         Err.Clear
  517.         blnConnect = True     'An error occurred
  518.         Exit Function
  519.     End If
  520.  
  521.     ' Connect to the namespace which is either local or remote
  522.     Set objService = objLocator.ConnectServer (strServer, strNameSpace, _
  523.         strUserName, strPassword)
  524.     ObjService.Security_.impersonationlevel = 3
  525.     If Err.Number then
  526.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in connecting to server " _
  527.             & strServer & "."
  528.         If Err.Description <> "" Then
  529.             Print "Error description: " & Err.Description & "."
  530.         End If
  531.         Err.Clear
  532.         blnConnect = True     'An error occurred
  533.     End If
  534.  
  535. End Function
  536.  
  537. '********************************************************************
  538. '*
  539. '* Function blnGetAllProperties()
  540. '* Purpose: Gets all possible properties of a job.
  541. '* Input:   objService          a service object
  542. '*          strClass            a class name
  543. '* Output:  strProperties       an array containing all possible properties of a job
  544. '*          strPropertyTypes    an array containing CIM Types of all possible
  545. '*                              properties of a job
  546. '*
  547. '********************************************************************
  548.  
  549. Private Function blnGetAllProperties(objService, strClass, strProperties, strPropertyTypes)
  550.  
  551.     ON ERROR RESUME NEXT
  552.  
  553.     Dim objClass, objWbemProperty, i
  554.  
  555.     blnGetAllProperties = False
  556.  
  557.     Set objClass = objService.Get(strClass)
  558.     If Err.Number then
  559.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting a class object."
  560.         If Err.Description <> "" Then
  561.             Print "Error description: " & Err.Description & "."
  562.         End If
  563.         blnGetAllProperties = True
  564.         Err.Clear
  565.         Exit Function
  566.     End If
  567.  
  568.     i = -1
  569.     For Each objWbemProperty in objClass.Properties_
  570.         i = i + 1
  571.         ReDim Preserve strProperties(i), strPropertyTypes(i)
  572.         strProperties(i) = objWbemProperty.Name
  573.         strPropertyTypes(i) = strCIMType(objWbemProperty.CIMType)
  574.         If Err.Number Then
  575.             blnGetAllProperties = True
  576.         End If
  577.     Next
  578.  
  579. End Function
  580.  
  581. '********************************************************************
  582. '*
  583. '* Sub ExecuteQuery()
  584. '* Purpose: Queries a server.
  585. '* Input:   objService      a service object
  586. '*          strQuery        a query string
  587. '*          strProperties   an array containing names of properties to be retrieved
  588. '*          intWidths       an array containing the width of columns used to display
  589. '*                          values of the corresponding properties
  590. '*          intSortOrder    specifies the sort order (ascend/descend/none)
  591. '*          intSortProperty specifies a property according to which the results
  592. '*                          will be sorted
  593. '*          blnFlush        specifies whether to use flush output
  594. '*          objOutputFile   an output file object
  595. '* Output:  Results of the query are either printed on screen or saved in objOutputFile.
  596. '*
  597. '********************************************************************
  598.  
  599. Private Sub ExecuteQuery(objService, strQuery, strProperties, intWidths, _
  600.     intSortProperty, intSortOrder, blnFlush, objOutputFile)
  601.  
  602.     ON ERROR RESUME NEXT
  603.  
  604.     Dim objEnumerator, objInstance, strMessage, i, j, k, intUBound
  605.  
  606.     intUBound = UBound(strProperties)
  607.     'Need to use redim so the last dimension can be resized
  608.     ReDim strResults(intUBound, 0), intOrder(0), strArray(0)
  609.  
  610.     Set objEnumerator = objService.ExecQuery(strQuery,,0)
  611.     If Err.Number Then
  612.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred during the query."
  613.         If Err.Description <> "" Then
  614.             Print "Error description: " & Err.Description & "."
  615.         End If
  616.         Err.Clear
  617.         Exit Sub
  618.     End If
  619.  
  620.     'Read properties into arrays.
  621.     i = 0
  622.     For Each objInstance in objEnumerator
  623.         If objInstance is nothing Then
  624.             Exit For
  625.         End If
  626.         ReDim Preserve strResults(intUBound, i), intOrder(i), strArray(i)
  627.         For j = 0 To intUBound
  628.             If LCase(strProperties(j)) = "processid" Then
  629.                 strResults(j, i) = objInstance.properties_(strProperties(j))
  630.                 If strResults(j, i) < 0 Then
  631.                     '4294967296 is 0x100000000.
  632.                     strResults(j, i) = CStr(strResults(j, i) + 4294967296)
  633.                 End If
  634.             Else
  635.                 strResults(j, i) = CStr(objInstance.properties_(strProperties(j)))
  636.             End If
  637.             If Err.Number Then
  638.                 Err.Clear
  639.                 strResults(j, i) = "(null)"
  640.             End If
  641.         Next
  642.         intOrder(i) = i
  643.         'Copy the property values to be sorted.
  644.         strArray(i) = strResults(intSortProperty-1, i)
  645.         i = i + 1
  646.         If Err.Number Then
  647.             Err.Clear
  648.         End If
  649.     Next
  650.  
  651.     'Check the data type of the property to be sorted
  652.     k = CDbl(strArray(0))
  653.     If Err.Number Then      'not a number
  654.         Err.Clear
  655.     Else                    'a number
  656.         'Pack empty spaces at the begining of each number
  657.         For j = 0 To UBound(strArray)
  658.             'Assume the longest number would be less than 40 digits.
  659.             strArray(j) = strPackString(strArray(j), 40, 0, 0)
  660.         Next
  661.     End If
  662.  
  663.     If i > 0 Then
  664.         'Print the header
  665.         strMessage = vbCRLF & Space(2)
  666.         For j = 0 To intUBound
  667.             strMessage = strMessage & UCase(strPackString(strProperties(j), _
  668.                 intWidths(j), 1, blnFlush))
  669.         Next
  670.         WriteLine strMessage & vbCRLF, objOutputFile
  671.  
  672.         'Sort strArray
  673.         Select Case intSortOrder
  674.             Case CONST_SORT_NO
  675.                  'Do nothing
  676.             Case CONST_SORT_ASCENDING
  677.                  Call SortArray(strArray, 1, intOrder, 0)
  678.             Case CONST_SORT_DESCENDING
  679.                  Call SortArray(strArray, 0, intOrder, 0)
  680.             Case Else
  681.                 Print "Error occurred in passing parameters."
  682.                 Exit Sub
  683.         End Select
  684.  
  685.         If intSortOrder <> CONST_SORT_NO Then
  686.             For j = 0 To intUBound
  687.                 'First copy results to strArray and change the order of elements.
  688.                 For k = 0 To i-1    'i is number of instances retrieved.
  689.                     strArray(k) = strResults(j, intOrder(k))
  690.                 Next
  691.                 'Now copy results back to strResults.
  692.                 For k = 0 To i-1    'i is number of instances retrieved.
  693.                     strResults(j, k) = strArray(k)
  694.                 Next
  695.             Next
  696.         End If
  697.  
  698.         For k = 0 To i-1
  699.             strMessage = Space(2)
  700.             For j = 0 To intUBound
  701.                 strMessage = strMessage & strPackString(strResults(j, k), _
  702.                     intWidths(j), 1, blnFlush)
  703.             Next
  704.             WriteLine strMessage, objOutputFile
  705.         Next
  706.     End If
  707.  
  708. End Sub
  709.  
  710. '********************************************************************
  711. '*
  712. '* Function blnDeleteOneElement()
  713. '* Purpose: Deletes one element from an array.
  714. '* Input:   i          the index of the element to be deleted
  715. '*          strArray   the array to work on
  716. '* Output:  strArray   the array with the i-th element deleted
  717. '*          blnDeleteOneElement is set to True if an error occurred and False otherwise.
  718. '*
  719. '********************************************************************
  720.  
  721. Private Function blnDeleteOneElement(ByVal i, strArray)
  722.  
  723.     ON ERROR RESUME NEXT
  724.  
  725.     Dim j, intUbound
  726.  
  727.     blnDeleteOneElement = False        'No error
  728.  
  729.     If Not IsArray(strArray) Then
  730.         blnDeleteOneElement = True
  731.         Exit Function
  732.     End If
  733.  
  734.     intUbound = UBound(strArray)
  735.  
  736.     If i > intUBound Then
  737.         Print "Array index out of range!"
  738.         blnDeleteOneElement = True
  739.         Exit Function
  740.     ElseIf i < intUBound Then
  741.         For j = i To intUBound - 1
  742.             strArray(j) = strArray(j+1)
  743.         Next
  744.         j = j - 1
  745.     Else                                'i = intUBound
  746.         If intUBound = 0 Then           'There is only one element in the array
  747.             strArray(0) = ""            'set it to empty
  748.             j = 0
  749.         Else                            'Need to delete the last element (i-th element)
  750.             j = intUBound - 1
  751.         End If
  752.     End If
  753.  
  754.     ReDim Preserve strArray(j)
  755.  
  756. End Function
  757.  
  758. '********************************************************************
  759. '*
  760. '* Sub SortArray()
  761. '* Purpose: Sorts an array and arrange another array accordingly.
  762. '* Input:   strArray    the array to be sorted
  763. '*          blnOrder    True for ascending and False for descending
  764. '*          strArray2   an array that has exactly the same number of elements as strArray
  765. '*                      and will be reordered together with strArray
  766. '*          blnCase     indicates whether the order is case sensitive
  767. '* Output:  The sorted arrays are returned in the original arrays.
  768. '* Note:    Repeating elements are not deleted.
  769. '*
  770. '********************************************************************
  771.  
  772. Private Sub SortArray(strArray, blnOrder, strArray2, blnCase)
  773.  
  774.     ON ERROR RESUME NEXT
  775.  
  776.     Dim i, j, intUbound
  777.  
  778.     If IsArray(strArray) Then
  779.         intUbound = UBound(strArray)
  780.     Else
  781.         Print "Argument is not an array!"
  782.         Exit Sub
  783.     End If
  784.  
  785.     blnOrder = CBool(blnOrder)
  786.     blnCase = CBool(blnCase)
  787.     If Err.Number Then
  788.         Print "Argument is not a boolean!"
  789.         Exit Sub
  790.     End If
  791.  
  792.     i = 0
  793.     Do Until i > intUbound-1
  794.         j = i + 1
  795.         Do Until j > intUbound
  796.             If blnCase Then     'Case sensitive
  797.                 If (strArray(i) > strArray(j)) and blnOrder Then
  798.                     Swap strArray(i), strArray(j)   'swaps element i and j
  799.                     Swap strArray2(i), strArray2(j)
  800.                 ElseIf (strArray(i) < strArray(j)) and Not blnOrder Then
  801.                     Swap strArray(i), strArray(j)   'swaps element i and j
  802.                     Swap strArray2(i), strArray2(j)
  803.                 ElseIf strArray(i) = strArray(j) Then
  804.                     'Move element j to next to i
  805.                     If j > i + 1 Then
  806.                         Swap strArray(i+1), strArray(j)
  807.                         Swap strArray2(i+1), strArray2(j)
  808.                     End If
  809.                 End If
  810.             Else                 'Not case sensitive
  811.                 If (LCase(strArray(i)) > LCase(strArray(j))) and blnOrder Then
  812.                     Swap strArray(i), strArray(j)   'swaps element i and j
  813.                     Swap strArray2(i), strArray2(j)
  814.                 ElseIf (LCase(strArray(i)) < LCase(strArray(j))) and Not blnOrder Then
  815.                     Swap strArray(i), strArray(j)   'swaps element i and j
  816.                     Swap strArray2(i), strArray2(j)
  817.                 ElseIf LCase(strArray(i)) = LCase(strArray(j)) Then
  818.                     'Move element j to next to i
  819.                     If j > i + 1 Then
  820.                         Swap strArray(i+1), strArray(j)
  821.                         Swap strArray2(i+1), strArray2(j)
  822.                     End If
  823.                 End If
  824.             End If
  825.             j = j + 1
  826.         Loop
  827.         i = i + 1
  828.     Loop
  829.  
  830. End Sub
  831.  
  832. '********************************************************************
  833. '*
  834. '* Sub Swap()
  835. '* Purpose: Exchanges values of two strings.
  836. '* Input:   strA    a string
  837. '*          strB    another string
  838. '* Output:  Values of strA and strB are exchanged.
  839. '*
  840. '********************************************************************
  841.  
  842. Private Sub Swap(ByRef strA, ByRef strB)
  843.  
  844.     Dim strTemp
  845.  
  846.     strTemp = strA
  847.     strA = strB
  848.     strB = strTemp
  849.  
  850. End Sub
  851.  
  852. '********************************************************************
  853. '*
  854. '* Function strCIMType()
  855. '* Purpose: Finds the name of CIMType corresponding to an integer.
  856. '* Input:   intCIMType an integer corresponding to a CIM type
  857. '* Output:  strCIMType is returned as the name of the CIM type.
  858. '*
  859. '********************************************************************
  860.  
  861. Private Function strCIMType(intCIMType)
  862.  
  863.     Select Case intCIMType
  864.         Case 2
  865.             strCIMType = "CIM_SINT16"
  866.         Case 3
  867.             strCIMType = "CIM_SINT32"
  868.         Case 4
  869.             strCIMType = "CIM_REAL32"
  870.         Case 5
  871.             strCIMType = "CIM_REAL64"
  872.         Case 8
  873.             strCIMType = "CIM_STRING"
  874.         Case 11
  875.             strCIMType = "CIM_BOOLEAN"
  876.         Case 13
  877.             strCIMType = "CIM_OBJECT"
  878.         Case 17
  879.             strCIMType = "CIM_UINT8"
  880.         Case 18
  881.             strCIMType = "CIM_UINT16"
  882.         Case 19
  883.             strCIMType = "CIM_UINT32"
  884.         Case 20
  885.             strCIMType = "CIM_SINT64"
  886.         Case 21
  887.             strCIMType = "CIM_UINT64"
  888.         Case 101
  889.             strCIMType = "CIM_DATETIME"
  890.         Case 102
  891.             strCIMType = "CIM_REFERENCE"
  892.         Case 103
  893.             strCIMType = "CIM_CHAR16"
  894.         Case Else
  895.             strCIMType = CStr(intCIMType)
  896.     End Select
  897.  
  898. End Function
  899.  
  900. '********************************************************************
  901. '*
  902. '* Function strPackString()
  903. '* Purpose: Attaches spaces to a string to increase the length to intWidth.
  904. '* Input:   strString   a string
  905. '*          intWidth   the intended length of the string
  906. '*          blnAfter    specifies whether to add spaces after or before the string
  907. '*          blnTruncate specifies whether to truncate the string or not if
  908. '*                      the string length is longer than intWidth
  909. '* Output:  strPackString is returned as the packed string.
  910. '*
  911. '********************************************************************
  912.  
  913. Private Function strPackString(strString, ByVal intWidth, blnAfter, blnTruncate)
  914.  
  915.     ON ERROR RESUME NEXT
  916.  
  917.     intWidth = CInt(intWidth)
  918.     blnAfter = CBool(blnAfter)
  919.     blnTruncate = CBool(blnTruncate)
  920.     If Err.Number Then
  921.         Print "Argument type is incorrect!"
  922.         Err.Clear
  923.         WScript.Quit
  924.     End If
  925.  
  926.     If IsNull(strString) Then
  927.         strPackString = "null" & Space(intWidth-4)
  928.         Exit Function
  929.     End If
  930.  
  931.     strString = CStr(strString)
  932.     If Err.Number Then
  933.         Print "Argument type is incorrect!"
  934.         Err.Clear
  935.         WScript.Quit
  936.     End If
  937.  
  938.     If intWidth > Len(strString) Then
  939.         If blnAfter Then
  940.             strPackString = strString & Space(intWidth-Len(strString))
  941.         Else
  942.             strPackString = Space(intWidth-Len(strString)) & strString & " "
  943.         End If
  944.     Else
  945.         If blnTruncate Then
  946.             strPackString = Left(strString, intWidth-1) & " "
  947.         Else
  948.             strPackString = strString & " "
  949.         End If
  950.     End If
  951.  
  952. End Function
  953.  
  954. '********************************************************************
  955. '*
  956. '* Sub WriteLine()
  957. '* Purpose: Writes a text line either to a file or on screen.
  958. '* Input:   strMessage  the string to print
  959. '*          objFile     an output file object
  960. '* Output:  strMessage is either displayed on screen or written to a file.
  961. '*
  962. '********************************************************************
  963.  
  964. Sub WriteLine(ByRef strMessage, ByRef objFile)
  965.  
  966.     If IsObject(objFile) then        'objFile should be a file object
  967.         objFile.WriteLine strMessage
  968.     Else
  969.         WScript.Echo  strMessage
  970.     End If
  971.  
  972. End Sub
  973.  
  974. '********************************************************************
  975. '*
  976. '* Sub Print()
  977. '* Purpose: Prints a message on screen.
  978. '* Input:   strMessage      the string to print
  979. '* Output:  strMessage is printed on screen.
  980. '*
  981. '********************************************************************
  982.  
  983. Sub Print(ByRef strMessage)
  984.     WScript.Echo  strMessage
  985. End Sub
  986.  
  987. '********************************************************************
  988. '*                                                                  *
  989. '*                           End of File                            *
  990. '*                                                                  *
  991. '********************************************************************
  992.  
  993. '********************************************************************
  994. '*
  995. '* Procedures calling sequence: QUERY.VBS
  996. '*
  997. '*        intParseCmdLine
  998. '*        ShowUsage
  999. '*        Query
  1000. '*              blnConnect
  1001. '*              ExecuteQuery
  1002. '*                  strPackString
  1003. '*                  SortArray
  1004. '*                      Swap
  1005. '*                  WriteLine
  1006. '*
  1007. '********************************************************************
  1008.  
  1009. '********************************************************************
  1010. '*
  1011. '* Sub Debug()
  1012. '* Purpose:   Prints a debug message and the error condition.
  1013. '* Input:     i             an integer
  1014. '*            strMessage    a message string
  1015. '* Output:    A message is printed on screen.
  1016. '*
  1017. '********************************************************************
  1018.  
  1019. Sub Debug(i, strMessage)
  1020.     If Err.Number then
  1021.         Wscript.echo "Error 0X" & Hex(Err.Number) & " occurred."
  1022.         Wscript.echo "Error description " & i & "  " & Err.Description
  1023.         Wscript.echo strMessage
  1024. '        Err.Clear
  1025.     Else
  1026.         Wscript.echo "No problem " & i
  1027.         Wscript.echo strMessage
  1028.     End If
  1029. End Sub
  1030.  
  1031. '********************************************************************
  1032. '*
  1033. '* Sub PrintArray()
  1034. '* Purpose:   Prints all elements of an array on screen.
  1035. '* Input:     strArray    an array name
  1036. '* Output:    All elements of the array are printed on screen.
  1037. '*
  1038. '********************************************************************
  1039.  
  1040. Sub PrintArray(strArray)
  1041.  
  1042.     Dim i
  1043.  
  1044.     For i = 0 To UBound(strArray)
  1045.         Wscript.echo strArray(i)
  1046.     Next
  1047.  
  1048. End Sub
  1049.