home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 May / W2KPRK.iso / ras.cab / programgroups.vbs < prev    next >
Text File  |  1999-11-04  |  22KB  |  638 lines
  1. '********************************************************************
  2. '*
  3. '* File:           ProgramGroups.vbs 
  4. '* Created:        March 1999
  5. '* Version:        1.0
  6. '*
  7. '*  Main Function:  Enumerates the program groups on a machine.
  8. '*
  9. '*  ProgramGroups.vbs       [/S <server>] [/U <username>] [/W <password>] 
  10. '*                          [/O <outputfile>]
  11. '*
  12. '* Copyright (C) 1999 Microsoft Corporation
  13. '*
  14. '********************************************************************
  15.  
  16. OPTION EXPLICIT
  17.  
  18.     'Define constants
  19.     CONST CONST_ERROR                   = 0
  20.     CONST CONST_WSCRIPT                 = 1
  21.     CONST CONST_CSCRIPT                 = 2
  22.     CONST CONST_SHOW_USAGE              = 3
  23.     CONST CONST_PROCEED                 = 4
  24.  
  25.     'Declare variables
  26.     Dim intOpMode, i
  27.     Dim strServer, strUserName, strPassword, strOutputFile
  28.  
  29.     'Make sure the host is csript, if not then abort
  30.     VerifyHostIsCscript()
  31.  
  32.     'Parse the command line
  33.     intOpMode = intParseCmdLine(strServer     ,  _
  34.                                 strUserName   ,  _
  35.                                 strPassword   ,  _
  36.                                 strOutputFile    )
  37.  
  38.  
  39.     Select Case intOpMode
  40.  
  41.         Case CONST_SHOW_USAGE
  42.             Call ShowUsage()
  43.  
  44.         Case CONST_PROCEED                 
  45.             Call LstProgramGroups(strServer     , _
  46.                                   strOutputFile , _
  47.                                   strUserName   , _
  48.                                   strPassword     )
  49.  
  50.         Case CONST_ERROR
  51.             'Do Nothing
  52.  
  53.         Case Else                    'Default -- should never happen
  54.             Call Wscript.Echo("Error occurred in passing parameters.")
  55.  
  56.     End Select
  57.  
  58. '********************************************************************
  59. '* End of Script
  60. '********************************************************************
  61.  
  62. '********************************************************************
  63. '*
  64. '* Sub LstProgramGroups()
  65. '*
  66. '* Purpose: Enumerates the program groups on a machine.
  67. '*
  68. '* Input:   strServer           a machine name
  69. '*          strOutputFile       an output file name
  70. '*          strUserName         the current user's name
  71. '*          strPassword         the current user's password
  72. '*
  73. '* Output:  Results are either printed on screen or saved in strOutputFile.
  74. '*
  75. '********************************************************************
  76. Private Sub LstProgramGroups(strServer, strOutputFile, strUserName, strPassword)
  77.  
  78.     ON ERROR RESUME NEXT
  79.  
  80.     Dim objFileSystem, objOutputFile, objService
  81.     Dim objWshNet, objStSet, objStart
  82.     Dim strQuery, strMessage, strCat
  83.  
  84.     'Open a text file for output if the file is requested
  85.     If Not IsEmpty(strOutputFile) Then
  86.         If (NOT blnOpenFile(strOutputFile, objOutputFile)) Then
  87.             Call Wscript.Echo ("Could not open an output file.")
  88.             Exit Sub
  89.         End If
  90.     End If
  91.  
  92.     'Establish a connection with the server.
  93.     If blnConnect("root\cimv2" , _
  94.                    strUserName , _
  95.                    strPassword , _
  96.                    strServer   , _
  97.                    objService  ) Then
  98.         Call Wscript.Echo("")
  99.         Call Wscript.Echo("Please check the server name, " _
  100.                         & "credentials and WBEM Core.")
  101.         Exit Sub
  102.     End If
  103.  
  104.     'Get the startup commands
  105.     Set objStSet = objService.InstancesOf("Win32_ProgramGroup")
  106.     If Err.Number Then
  107.         Print "Error 0x" & CStr(Hex(Err.Number)) & _
  108.               " occurred obtaining the program groups."
  109.         If Err.Description <> "" Then
  110.             Wscript.Echo "Error description: " & Err.Description & "."
  111.         End If
  112.         Err.Clear
  113.         Exit Sub
  114.     End If
  115.  
  116.     If IsEmpty(strServer) Then
  117.         Set objWshNet = CreateObject("Wscript.Network")
  118.         strServer = objWshNet.ComputerName
  119.     End If
  120.  
  121.     Call WriteLine("Program groups on Machine " & strServer, objOutputFile)
  122.     Call WriteLine("", objOutputFile)
  123.     
  124.     'Generate the header
  125.     strMessage = Empty
  126.     strMessage = strMessage + strPackString("User",       25, 1, 1)
  127.     strMessage = strMessage + strPackString("Group Name", 55, 1, 1)
  128.     Call WriteLine(strMessage, objOutputFile)
  129.  
  130.     For Each objStart in objStSet
  131.         strMessage = Empty
  132.         strMessage = strMessage + strPackString(objStart.UserName,  25, 1, 1)
  133.         strMessage = strMessage + strPackString(objStart.GroupName, 55, 1, 1)
  134.         Call WriteLine(strMessage, objOutputFile)
  135.     Next
  136.  
  137.     If IsObject(objOutputFile) Then
  138.         objOutputFile.Close
  139.         Call Wscript.Echo ("Results are saved in file " & strOutputFile & ".")
  140.     End If
  141.  
  142. End Sub
  143.  
  144. '********************************************************************
  145. '*
  146. '* Function intParseCmdLine()
  147. '*
  148. '* Purpose: Parses the command line.
  149. '* Input:   
  150. '*
  151. '* Output:  strServer         a remote server ("" = local server")
  152. '*          strUserName       the current user's name
  153. '*          strPassword       the current user's password
  154. '*          strOutputFile     an output file name
  155. '*
  156. '********************************************************************
  157. Private Function intParseCmdLine( ByRef strServer,        _
  158.                                   ByRef strUserName,      _
  159.                                   ByRef strPassword,      _
  160.                                   ByRef strOutputFile     )
  161.  
  162.  
  163.     ON ERROR RESUME NEXT
  164.  
  165.     Dim strFlag
  166.     Dim intState, intArgIter
  167.     Dim objFileSystem
  168.  
  169.     If Wscript.Arguments.Count > 0 Then
  170.         strFlag = Wscript.arguments.Item(0)
  171.     End If
  172.  
  173.     If IsEmpty(strFlag) Then                'No arguments have been received
  174.         intParseCmdLine = CONST_PROCEED
  175.         Exit Function
  176.     End If
  177.  
  178.     'Check if the user is asking for help or is just confused
  179.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  180.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") _ 
  181.         OR (strFlag="h") Then
  182.         intParseCmdLine = CONST_SHOW_USAGE
  183.         Exit Function
  184.     End If
  185.  
  186.     'Retrieve the command line and set appropriate variables
  187.      intArgIter = 0
  188.     Do While intArgIter <= Wscript.arguments.Count - 1
  189.         Select Case Left(LCase(Wscript.arguments.Item(intArgIter)),2)
  190.   
  191.             Case "/s"
  192.                 If Not blnGetArg("Server", strServer, intArgIter) Then
  193.                     intParseCmdLine = CONST_ERROR
  194.                     Exit Function
  195.                 End If
  196.                 intArgIter = intArgIter + 1
  197.  
  198.             Case "/o"
  199.                 If Not blnGetArg("Output File", strOutputFile, intArgIter) Then
  200.                     intParseCmdLine = CONST_ERROR
  201.                     Exit Function
  202.                 End If
  203.                 intArgIter = intArgIter + 1
  204.  
  205.             Case "/u"
  206.                 If Not blnGetArg("User Name", strUserName, intArgIter) Then
  207.                     intParseCmdLine = CONST_ERROR
  208.                     Exit Function
  209.                 End If
  210.                 intArgIter = intArgIter + 1
  211.  
  212.             Case "/w"
  213.                 If Not blnGetArg("User Password", strPassword, intArgIter) Then
  214.                     intParseCmdLine = CONST_ERROR
  215.                     Exit Function
  216.                 End If
  217.                 intArgIter = intArgIter + 1
  218.  
  219.             Case Else 'We shouldn't get here
  220.                 Call Wscript.Echo("Invalid or misplaced parameter: " _
  221.                    & Wscript.arguments.Item(intArgIter) & vbCRLF _
  222.                    & "Please check the input and try again," & vbCRLF _
  223.                    & "or invoke with '/?' for help with the syntax.")
  224.                 Wscript.Quit
  225.  
  226.         End Select
  227.  
  228.     Loop '** intArgIter <= Wscript.arguments.Count - 1
  229.  
  230.     If IsEmpty(intParseCmdLine) Then _
  231.         intParseCmdLine = CONST_PROCEED
  232.  
  233. End Function
  234.  
  235. '********************************************************************
  236. '*
  237. '* Sub ShowUsage()
  238. '*
  239. '* Purpose: Shows the correct usage to the user.
  240. '*
  241. '* Input:   None
  242. '*
  243. '* Output:  Help messages are displayed on screen.
  244. '*
  245. '********************************************************************
  246. Private Sub ShowUsage()
  247.  
  248.     Wscript.Echo ""
  249.     Wscript.Echo "Enumerates the program groups on a machine."
  250.     Wscript.Echo ""
  251.     Wscript.Echo "SYNTAX:"
  252.     Wscript.Echo "  ProgramGroups.vbs [/S <server>] [/U <username>]" _
  253.                 &" [/W <password>]"
  254.     Wscript.Echo "  [/O <outputfile>]"
  255.     Wscript.Echo ""
  256.     Wscript.Echo "PARAMETER SPECIFIERS:"
  257.     Wscript.Echo "   server        A machine name."
  258.     Wscript.Echo "   username      The current user's name."
  259.     Wscript.Echo "   password      Password of the current user."
  260.     Wscript.Echo "   outputfile    The output file name."
  261.     Wscript.Echo ""
  262.     Wscript.Echo "EXAMPLE:"
  263.     Wscript.Echo "1. cscript ProgramGroups.VBS"
  264.     Wscript.Echo "   Lists program groups on the current machine."
  265.     Wscript.Echo "2. cscript ProgramGroups.VBS /S MyMachine2"
  266.     Wscript.Echo "   Lists program groups on the machine MyMachine2."
  267.     
  268. End Sub
  269.  
  270. '********************************************************************
  271. '* General Routines
  272. '********************************************************************
  273.  
  274. '********************************************************************
  275. '*
  276. '* Function strPackString()
  277. '*
  278. '* Purpose: Attaches spaces to a string to increase the length to intWidth.
  279. '*
  280. '* Input:   strString   a string
  281. '*          intWidth    the intended length of the string
  282. '*          blnAfter    Should spaces be added after the string?
  283. '*          blnTruncate specifies whether to truncate the string or not if
  284. '*                      the string length is longer than intWidth
  285. '*
  286. '* Output:  strPackString is returned as the packed string.
  287. '*
  288. '********************************************************************
  289. Private Function strPackString( ByVal strString, _
  290.                                 ByVal intWidth,  _
  291.                                 ByVal blnAfter,  _
  292.                                 ByVal blnTruncate)
  293.  
  294.     ON ERROR RESUME NEXT
  295.  
  296.     intWidth      = CInt(intWidth)
  297.     blnAfter      = CBool(blnAfter)
  298.     blnTruncate   = CBool(blnTruncate)
  299.  
  300.     If Err.Number Then
  301.         Call Wscript.Echo ("Argument type is incorrect!")
  302.         Err.Clear
  303.         Wscript.Quit
  304.     End If
  305.  
  306.     If IsNull(strString) Then
  307.         strPackString = "null" & Space(intWidth-4)
  308.         Exit Function
  309.     End If
  310.  
  311.     strString = CStr(strString)
  312.     If Err.Number Then
  313.         Call Wscript.Echo ("Argument type is incorrect!")
  314.         Err.Clear
  315.         Wscript.Quit
  316.     End If
  317.  
  318.     If intWidth > Len(strString) Then
  319.         If blnAfter Then
  320.             strPackString = strString & Space(intWidth-Len(strString))
  321.         Else
  322.             strPackString = Space(intWidth-Len(strString)) & strString & " "
  323.         End If
  324.     Else
  325.         If blnTruncate Then
  326.             strPackString = Left(strString, intWidth-1) & " "
  327.         Else
  328.             strPackString = strString & " "
  329.         End If
  330.     End If
  331.  
  332. End Function
  333.  
  334. '********************************************************************
  335. '* 
  336. '*  Function blnGetArg()
  337. '*
  338. '*  Purpose: Helper to intParseCmdLine()
  339. '* 
  340. '*  Usage:
  341. '*
  342. '*     Case "/s" 
  343. '*       blnGetArg ("server name", strServer, intArgIter)
  344. '*
  345. '********************************************************************
  346. Private Function blnGetArg ( ByVal StrVarName,   _
  347.                              ByRef strVar,       _
  348.                              ByRef intArgIter) 
  349.  
  350.     blnGetArg = False 'failure, changed to True upon successful completion
  351.  
  352.     If Len(Wscript.Arguments(intArgIter)) > 2 then
  353.         If Mid(Wscript.Arguments(intArgIter),3,1) = ":" then
  354.             If Len(Wscript.Arguments(intArgIter)) > 3 then
  355.                 strVar = Right(Wscript.Arguments(intArgIter), _
  356.                          Len(Wscript.Arguments(intArgIter)) - 3)
  357.                 blnGetArg = True
  358.                 Exit Function
  359.             Else
  360.                 intArgIter = intArgIter + 1
  361.                 If intArgIter > (Wscript.Arguments.Count - 1) Then
  362.                     Call Wscript.Echo( "Invalid " & StrVarName & ".")
  363.                     Call Wscript.Echo( "Please check the input and try again.")
  364.                     Exit Function
  365.                 End If
  366.  
  367.                 strVar = Wscript.Arguments.Item(intArgIter)
  368.                 If Err.Number Then
  369.                     Call Wscript.Echo( "Invalid " & StrVarName & ".")
  370.                     Call Wscript.Echo( "Please check the input and try again.")
  371.                     Exit Function
  372.                 End If
  373.  
  374.                 If InStr(strVar, "/") Then
  375.                     Call Wscript.Echo( "Invalid " & StrVarName)
  376.                     Call Wscript.Echo( "Please check the input and try again.")
  377.                     Exit Function
  378.                 End If
  379.  
  380.                 blnGetArg = True 'success
  381.             End If
  382.         Else
  383.             strVar = Right(Wscript.Arguments(intArgIter), _
  384.                      Len(Wscript.Arguments(intArgIter)) - 2)
  385.             blnGetArg = True 'success
  386.             Exit Function
  387.         End If
  388.     Else
  389.         intArgIter = intArgIter + 1
  390.         If intArgIter > (Wscript.Arguments.Count - 1) Then
  391.             Call Wscript.Echo( "Invalid " & StrVarName & ".")
  392.             Call Wscript.Echo( "Please check the input and try again.")
  393.             Exit Function
  394.         End If
  395.  
  396.         strVar = Wscript.Arguments.Item(intArgIter)
  397.         If Err.Number Then
  398.             Call Wscript.Echo( "Invalid " & StrVarName & ".")
  399.             Call Wscript.Echo( "Please check the input and try again.")
  400.             Exit Function
  401.         End If
  402.  
  403.         If InStr(strVar, "/") Then
  404.             Call Wscript.Echo( "Invalid " & StrVarName)
  405.             Call Wscript.Echo( "Please check the input and try again.")
  406.             Exit Function
  407.         End If
  408.         blnGetArg = True 'success
  409.     End If
  410. End Function
  411.  
  412. '********************************************************************
  413. '*
  414. '* Function blnConnect()
  415. '*
  416. '* Purpose: Connects to machine strServer.
  417. '*
  418. '* Input:   strServer       a machine name
  419. '*          strNameSpace    a namespace
  420. '*          strUserName     name of the current user
  421. '*          strPassword     password of the current user
  422. '*
  423. '* Output:  objService is returned  as a service object.
  424. '*          strServer is set to local host if left unspecified
  425. '*
  426. '********************************************************************
  427. Private Function blnConnect(ByVal strNameSpace, _
  428.                             ByVal strUserName,  _
  429.                             ByVal strPassword,  _
  430.                             ByRef strServer,    _
  431.                             ByRef objService)
  432.  
  433.     ON ERROR RESUME NEXT
  434.  
  435.     Dim objLocator, objWshNet
  436.  
  437.     blnConnect = False     'There is no error.
  438.  
  439.     'Create Locator object to connect to remote CIM object manager
  440.     Set objLocator = CreateObject("WbemScripting.SWbemLocator")
  441.     If Err.Number then
  442.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & _
  443.                            " occurred in creating a locator object." )
  444.         If Err.Description <> "" Then
  445.             Call Wscript.Echo( "Error description: " & Err.Description & "." )
  446.         End If
  447.         Err.Clear
  448.         blnConnect = True     'An error occurred
  449.         Exit Function
  450.     End If
  451.  
  452.     'Connect to the namespace which is either local or remote
  453.     Set objService = objLocator.ConnectServer (strServer, strNameSpace, _
  454.        strUserName, strPassword)
  455.     ObjService.Security_.impersonationlevel = 3
  456.     If Err.Number then
  457.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & _
  458.                            " occurred in connecting to server " _
  459.            & strServer & ".")
  460.         If Err.Description <> "" Then
  461.             Call Wscript.Echo( "Error description: " & Err.Description & "." )
  462.         End If
  463.         Err.Clear
  464.         blnConnect = True     'An error occurred
  465.     End If
  466.  
  467.     'Get the current server's name if left unspecified
  468.     If IsEmpty(strServer) Then
  469.         Set objWshNet = CreateObject("Wscript.Network")
  470.     strServer     = objWshNet.ComputerName
  471.     End If
  472.  
  473. End Function
  474.  
  475. '********************************************************************
  476. '*
  477. '* Sub      VerifyHostIsCscript()
  478. '*
  479. '* Purpose: Determines which program is used to run this script.
  480. '*
  481. '* Input:   None
  482. '*
  483. '* Output:  If host is not cscript, then an error message is printed 
  484. '*          and the script is aborted.
  485. '*
  486. '********************************************************************
  487. Sub VerifyHostIsCscript()
  488.  
  489.     ON ERROR RESUME NEXT
  490.  
  491.     Dim strFullName, strCommand, i, j, intStatus
  492.  
  493.     strFullName = WScript.FullName
  494.  
  495.     If Err.Number then
  496.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & " occurred." )
  497.         If Err.Description <> "" Then
  498.             Call Wscript.Echo( "Error description: " & Err.Description & "." )
  499.         End If
  500.         intStatus =  CONST_ERROR
  501.     End If
  502.  
  503.     i = InStr(1, strFullName, ".exe", 1)
  504.     If i = 0 Then
  505.         intStatus =  CONST_ERROR
  506.     Else
  507.         j = InStrRev(strFullName, "\", i, 1)
  508.         If j = 0 Then
  509.             intStatus =  CONST_ERROR
  510.         Else
  511.             strCommand = Mid(strFullName, j+1, i-j-1)
  512.             Select Case LCase(strCommand)
  513.                 Case "cscript"
  514.                     intStatus = CONST_CSCRIPT
  515.                 Case "wscript"
  516.                     intStatus = CONST_WSCRIPT
  517.                 Case Else       'should never happen
  518.                     Call Wscript.Echo( "An unexpected program was used to " _
  519.                                        & "run this script." )
  520.                     Call Wscript.Echo( "Only CScript.Exe or WScript.Exe can " _
  521.                                        & "be used to run this script." )
  522.                     intStatus = CONST_ERROR
  523.                 End Select
  524.         End If
  525.     End If
  526.  
  527.     If intStatus <> CONST_CSCRIPT Then
  528.         Call WScript.Echo( "Please run this script using CScript." & vbCRLF & _
  529.              "This can be achieved by" & vbCRLF & _
  530.              "1. Using ""CScript ProgramGroups.vbs arguments"" for Windows 95/98 or" _
  531.              & vbCRLF & "2. Changing the default Windows Scripting Host " _
  532.              & "setting to CScript" & vbCRLF & "    using ""CScript " _
  533.              & "//H:CScript //S"" and running the script using" & vbCRLF & _
  534.              "    ""ProgramGroups.vbs arguments"" for Windows NT/2000." )
  535.         WScript.Quit
  536.     End If
  537.  
  538. End Sub
  539.  
  540. '********************************************************************
  541. '*
  542. '* Sub WriteLine()
  543. '* Purpose: Writes a text line either to a file or on screen.
  544. '* Input:   strMessage  the string to print
  545. '*          objFile     an output file object
  546. '* Output:  strMessage is either displayed on screen or written to a file.
  547. '*
  548. '********************************************************************
  549. Sub WriteLine(ByVal strMessage, ByVal objFile)
  550.  
  551.     On Error Resume Next
  552.     If IsObject(objFile) then        'objFile should be a file object
  553.         objFile.WriteLine strMessage
  554.     Else
  555.         Call Wscript.Echo( strMessage )
  556.     End If
  557.  
  558. End Sub
  559.  
  560. '********************************************************************
  561. '* 
  562. '* Function blnErrorOccurred()
  563. '*
  564. '* Purpose: Reports error with a string saying what the error occurred in.
  565. '*
  566. '* Input:   strIn        string saying what the error occurred in.
  567. '*
  568. '* Output:  displayed on screen 
  569. '* 
  570. '********************************************************************
  571. Private Function blnErrorOccurred (ByVal strIn)
  572.  
  573.     If Err.Number Then
  574.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & ": " & strIn)
  575.         If Err.Description <> "" Then
  576.             Call Wscript.Echo( "Error description: " & Err.Description)
  577.         End If
  578.         Err.Clear
  579.         blnErrorOccurred = True
  580.     Else
  581.         blnErrorOccurred = False
  582.     End If
  583.  
  584. End Function
  585.  
  586. '********************************************************************
  587. '* 
  588. '* Function blnOpenFile
  589. '*
  590. '* Purpose: Opens a file.
  591. '*
  592. '* Input:   strFileName        A string with the name of the file.
  593. '*
  594. '* Output:  Sets objOpenFile to a FileSystemObject and setis it to 
  595. '*            Nothing upon Failure.
  596. '* 
  597. '********************************************************************
  598. Private Function blnOpenFile(ByVal strFileName, ByRef objOpenFile)
  599.  
  600.     ON ERROR RESUME NEXT
  601.  
  602.     Dim objFileSystem
  603.  
  604.     Set objFileSystem = Nothing
  605.  
  606.     If IsEmpty(strFileName) OR strFileName = "" Then
  607.         blnOpenFile = False
  608.         Set objOpenFile = Nothing
  609.         Exit Function
  610.     End If
  611.  
  612.     'Create a file object
  613.     Set objFileSystem = CreateObject("Scripting.FileSystemObject")
  614.     If blnErrorOccurred("Could not create filesystem object.") Then
  615.         blnOpenFile = False
  616.         Set objOpenFile = Nothing
  617.         Exit Function
  618.     End If
  619.  
  620.     'Open the file for output
  621.     Set objOpenFile = objFileSystem.OpenTextFile(strFileName, 8, True)
  622.     If blnErrorOccurred("Could not open") Then
  623.         blnOpenFile = False
  624.         Set objOpenFile = Nothing
  625.         Exit Function
  626.     End If
  627.     blnOpenFile = True
  628.  
  629. End Function
  630.  
  631. '********************************************************************
  632. '*                                                                  *
  633. '*                           End of File                            *
  634. '*                                                                  *
  635. '********************************************************************
  636.  
  637.  
  638.