home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 Special / chip-cd_2001_spec_05.zip / spec_05 / ras.cab / keyboard.vbs < prev    next >
Text File  |  1999-11-04  |  22KB  |  648 lines

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