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