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