home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 Special / chip-cd_2001_spec_05.zip / spec_05 / ras.cab / pstop.vbs < prev    next >
Text File  |  1999-11-04  |  27KB  |  812 lines
  1. '********************************************************************
  2. '*
  3. '* File:           PsTop.VBS
  4. '* Created:        March 1999
  5. '* Version:        1.0
  6. '*
  7. '*  Main Function:  Gets CPU information for a machine.
  8. '*
  9. '*  PsTop.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.   Case CONST_SHOW_USAGE
  41.     Call ShowUsage()
  42.   Case CONST_PROCEED
  43.     Call ListJobs(strServer,        _
  44.                   strOutputFile,    _
  45.                   strUserName,      _
  46.                   strPassword)
  47.  
  48.     Case CONST_ERROR
  49.         'Do nothing.
  50.     Case Else                    'Default -- should never happen
  51.         Print "Error occurred in passing parameters."
  52. End Select
  53.  
  54. '********************************************************************
  55. '*
  56. '* Sub      ListJobs()
  57. '*
  58. '* Purpose: Lists all jobs currently running on a machine.
  59. '*
  60. '* Input:   strServer           a machine name
  61. '*          intWidth            the default column width
  62. '*          strUserName         the current user's name
  63. '*          strPassword         the current user's password
  64. '*          strOutputFile       an output file name
  65. '*
  66. '* Output:  Results are either printed on screen or saved in strOutputFile.
  67. '*
  68. '********************************************************************
  69. Private Sub ListJobs( strServer,        _
  70.                       strOutputFile,    _
  71.                       strUserName,      _
  72.                       strPassword)
  73.  
  74.     ON ERROR RESUME NEXT
  75.  
  76.     Dim objFileSystem, objOutputFile, objService, objEnumerator, objInstance
  77.     Dim strOutRow
  78.     Dim objProcList(), lngTimeProp()
  79.     Dim strOutColumn(8), intColumnWidths(8)
  80.     Dim i, j, intProcIndex, intObjects, intStart, intFinish, intStep
  81.  
  82.     intColumnWidths(1) = 20
  83.     intColumnWidths(2) = 10
  84.     intColumnWidths(3) = 14
  85.     
  86.     ReDim strPropertyTypes(0)
  87.  
  88.     'Open a text file for output if the file is requested
  89.     If Not IsEmpty(strOutputFile) Then
  90.         If (NOT blnOpenFile(strOutputFile, objOutputFile)) Then
  91.             Call Wscript.Echo ("Could not open an output file.")
  92.             Exit Sub
  93.         End If
  94.     End If
  95.  
  96.     'Establish a connection with the server.
  97.     If blnConnect("root\cimv2" , _
  98.                    strUserName , _
  99.                    strPassword , _
  100.                    strServer   , _
  101.                    objService  ) Then
  102.         Call Wscript.Echo("")
  103.         Call Wscript.Echo("Please check the server name, " _
  104.                         & "credentials and WBEM Core.")
  105.         Exit Sub
  106.     End If
  107.  
  108.     Set objEnumerator = objService.InstancesOf("Win32_Process")
  109.  
  110.     'Dimension the object array and the property array for 
  111.     '    the number of objects
  112.     Redim objProcList(CInt(objEnumerator.Count-1))
  113.     Redim lngTimeProp(CInt(objEnumerator.Count-1))
  114.  
  115.     intObjects = 0
  116.     'Fill the arrays as a prelude to sorting
  117.     'Filter out processes for which no times are available
  118.     For Each objInstance In objEnumerator
  119.  
  120.         If NOT IsNull(objInstance.UserModeTime) OR NOT _
  121.           IsNull(objInstance.KernelModeTime) Then
  122.             lngTimeProp(i) = 0
  123.             If NOT IsNull(objInstance.UserModeTime) Then
  124.                 lngTimeProp(intObjects) = lngTimeProp(intObjects) + _
  125.                     CLng(objInstance.UserModeTime)
  126.             End If
  127.             If NOT IsNull(objInstance.KernelModeTime) Then
  128.                 lngTimeProp(intObjects) = lngTimeProp(intObjects) + _
  129.                    CLng(objInstance.KernelModeTime)
  130.             End If
  131.               Set objProcList(intObjects) = objInstance
  132.             intObjects = intObjects + 1
  133.         End If
  134.     Next
  135.  
  136.     'Determine the number of processes to list
  137.     If 15 < intObjects Then
  138.         intObjects = 15
  139.     End If
  140.  
  141.     'Always sort in descending order
  142.     Call SortArray(lngTimeProp, 0, objProcList)
  143.  
  144.     'Construct the header
  145.     strOutColumn(1) = "Image Name"
  146.     strOutColumn(2) = "PID"
  147.     strOutColumn(3) = "CPU Time"
  148.  
  149.     For j = 1 To 3
  150.         strOutColumn(j) = strPackString(strOutColumn(j), _
  151.             intColumnWidths(j), 1, 1)
  152.     Next 'j
  153.  
  154.     strOutRow = CStr("")
  155.     For j = 1 To 3
  156.          strOutRow = strOutRow & strOutColumn(j)
  157.     Next 'j
  158.     Call WriteLine(strOutRow, objOutputFile)      
  159.  
  160.     'Output the data
  161.     intStart = 0
  162.     intFinish = intObjects - 1
  163.     intStep = 1
  164.  
  165.     For i = intStart To intFinish Step intStep
  166.     
  167.         strOutColumn(1) = objProcList(i).Name
  168.         strOutColumn(2) = CStr(CLng(objProcList(i).ProcessId))
  169.         strOutColumn(3) = FormatTime(lngTimeProp(i))
  170.  
  171.         For j = 1 To 3
  172.             strOutColumn(j) = strPackString(strOutColumn(j), _
  173.                 intColumnWidths(j), 1, 1)
  174.         Next 'j
  175.  
  176.         strOutRow = ""
  177.         For j = 1 To 3
  178.             strOutRow = strOutRow & strOutColumn(j)
  179.         Next 'j
  180.         Call WriteLine(strOutRow, objOutputFile)      
  181.     Next 'i
  182.  
  183.     If IsObject(objOutputFile) Then
  184.         objOutputFile.Close
  185.         Call Wscript.Echo ("Results are saved in file " & strOutputFile & ".")
  186.     End If
  187.  
  188. End Sub
  189.  
  190. '********************************************************************
  191. '*
  192. '* Function intParseCmdLine()
  193. '*
  194. '* Purpose: Parses the command line.
  195. '* Input:   
  196. '*
  197. '* Output:  strServer         a remote server ("" = local server")
  198. '*          strUserName       the current user's name
  199. '*          strPassword       the current user's password
  200. '*          strOutputFile     an output file name
  201. '*
  202. '********************************************************************
  203. Private Function intParseCmdLine( ByRef strServer,        _
  204.                                   ByRef strUserName,      _
  205.                                   ByRef strPassword,      _
  206.                                   ByRef strOutputFile     )
  207.  
  208.  
  209.     ON ERROR RESUME NEXT
  210.  
  211.     Dim strFlag
  212.     Dim intState, intArgIter, intWidth
  213.     Dim objFileSystem
  214.  
  215.     If Wscript.Arguments.Count > 0 Then
  216.         strFlag = Wscript.arguments.Item(0)
  217.     End If
  218.  
  219.     If IsEmpty(strFlag) Then                'No arguments have been received
  220.         intParseCmdLine = CONST_PROCEED
  221.         Exit Function
  222.     End If
  223.  
  224.     'Check if the user is asking for help or is just confused
  225.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  226.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") _ 
  227.         OR (strFlag="h") Then
  228.         intParseCmdLine = CONST_SHOW_USAGE
  229.         Exit Function
  230.     End If
  231.  
  232.     'Retrieve the command line and set appropriate variables
  233.      intArgIter = 0
  234.     Do While intArgIter <= Wscript.arguments.Count - 1
  235.         Select Case Left(LCase(Wscript.arguments.Item(intArgIter)),2)
  236.   
  237.             Case "/s"
  238.                 If Not blnGetArg("Server", strServer, intArgIter) Then
  239.                     intParseCmdLine = CONST_ERROR
  240.                     Exit Function
  241.                 End If
  242.                 intArgIter = intArgIter + 1
  243.  
  244.             Case "/o"
  245.                 If Not blnGetArg("Output File", strOutputFile, intArgIter) Then
  246.                     intParseCmdLine = CONST_ERROR
  247.                     Exit Function
  248.                 End If
  249.                 intArgIter = intArgIter + 1
  250.  
  251.             Case "/u"
  252.                 If Not blnGetArg("User Name", strUserName, intArgIter) Then
  253.                     intParseCmdLine = CONST_ERROR
  254.                     Exit Function
  255.                 End If
  256.                 intArgIter = intArgIter + 1
  257.  
  258.             Case "/w"
  259.                 If Not blnGetArg("User Password", strPassword, intArgIter) Then
  260.                     intParseCmdLine = CONST_ERROR
  261.                     Exit Function
  262.                 End If
  263.                 intArgIter = intArgIter + 1
  264.  
  265.             Case Else 'We shouldn't get here
  266.                 Call Wscript.Echo("Invalid or misplaced parameter: " _
  267.                    & Wscript.arguments.Item(intArgIter) & vbCRLF _
  268.                    & "Please check the input and try again," & vbCRLF _
  269.                    & "or invoke with '/?' for help with the syntax.")
  270.                 Wscript.Quit
  271.  
  272.         End Select
  273.  
  274.     Loop '** intArgIter <= Wscript.arguments.Count - 1
  275.  
  276.     If IsEmpty(intParseCmdLine) Then _
  277.         intParseCmdLine = CONST_PROCEED
  278.  
  279. End Function
  280.  
  281. '********************************************************************
  282. '*
  283. '* Sub ShowUsage()
  284. '*
  285. '* Purpose: Shows the correct usage to the user.
  286. '*
  287. '* Input:   None
  288. '*
  289. '* Output:  Help messages are displayed on screen.
  290. '*
  291. '********************************************************************
  292. Private Sub ShowUsage()
  293.  
  294.     Wscript.Echo ""
  295.     Wscript.Echo "List processes according to cpu usage in descending order."
  296.     Wscript.Echo ""
  297.     Wscript.Echo "SYNTAX:"
  298.     Wscript.Echo "  PsTop.vbs [/S <server>] [/U <username>]" _
  299.                 &" [/W <password>]"
  300.     Wscript.Echo "  [/O <outputfile>]"
  301.     Wscript.Echo ""
  302.     Wscript.Echo "PARAMETER SPECIFIERS:"
  303.     Wscript.Echo "   server        A machine name."
  304.     Wscript.Echo "   username      The current user's name."
  305.     Wscript.Echo "   password      Password of the current user."
  306.     Wscript.Echo "   outputfile    The output file name."
  307.     Wscript.Echo ""
  308.     Wscript.Echo "EXAMPLE:"
  309.     Wscript.Echo "1. cscript PsTop.vbs"
  310.     Wscript.Echo "   List the jobs running on the current machine."
  311.     Wscript.Echo "2. cscript PsTop.vbs /S MyMachine2"
  312.     Wscript.Echo "   List the jobs running on the machine MyMachine2."
  313.  
  314. End Sub
  315.  
  316.  
  317. '********************************************************************
  318. '*
  319. '* Sub SortArray()
  320. '*
  321. '* Purpose: Sorts two arrays based on the contents in one array.
  322. '*
  323. '* Input:   strArray    the array that contains the data to sort
  324. '*          blnOrder    True for ascending and False for descending
  325. '*          objArray2   an array that has exactly the same number of 
  326. '*                      elements as strArray
  327. '*                      and will be reordered with strArray
  328. '*
  329. '* Output:  The arrarys are returned in sort order.
  330. '*
  331. '* Note:    Repeating elements are not deleted.
  332. '*
  333. '********************************************************************
  334. Private Sub SortArray(varSortData, blnAscend, objList)
  335.  
  336.     ON ERROR RESUME NEXT
  337.  
  338.     Dim i, j, intUbound
  339.     Dim blnSwapped
  340.     Dim objSave
  341.  
  342.     If IsArray(varSortData) Then
  343.         intUbound = UBound(varSortData)
  344.     Else
  345.         Wscript.Echo("Argument is not an array!")
  346.         Exit Sub
  347.     End If
  348.  
  349.     'This is true if a swap occurs and false otherwise
  350.     blnSwapped = False
  351.  
  352.     blnAscend = CBool(blnAscend)
  353.     If Err.Number Then
  354.         Wscript.Echo("Argument is not a boolean!")
  355.         Exit Sub
  356.     End If
  357.  
  358.     If blnAscend Then
  359.  
  360.         Do
  361.             blnSwapped = False
  362.  
  363.             For i = 0 To intUbound - 1
  364.                 If varSortData(i) > varSortData(i+1) Then
  365.                     Call Swap( varSortData(i),  varSortData(i+1) )
  366.                     Set objSave       = objList(i+1)
  367.                     Set objList(i+1)  = objList(i)
  368.                     Set objList(i)    = objSave
  369.                     blnSwapped = True
  370.                 End If
  371.             Next 'i
  372.  
  373.         Loop While blnSwapped
  374.  
  375.     Else 'Descend
  376.         Do
  377.             blnSwapped = False
  378.  
  379.             For i = 0 To intUbound - 1
  380.                 If varSortData(i) < varSortData(i+1) Then
  381.                     Call Swap( varSortData(i),  varSortData(i+1) )
  382.                     Set objSave       = objList(i+1)
  383.                     Set objList(i+1)  = objList(i)
  384.                     Set objList(i)    = objSave
  385.                     blnSwapped = True
  386.                 End If
  387.             Next 'i
  388.  
  389.         Loop While blnSwapped
  390.     End If
  391.  
  392. End Sub
  393.  
  394. '********************************************************************
  395. '*
  396. '* Sub Swap()
  397. '* Purpose: Exchanges values of two strings.
  398. '* Input:   strA    a string
  399. '*          strB    another string
  400. '* Output:  Values of strA and strB are exchanged.
  401. '*
  402. '********************************************************************
  403. Private Sub Swap(ByRef strA, ByRef strB)
  404.  
  405.     Dim strTemp
  406.  
  407.     strTemp = strA
  408.     strA    = strB
  409.     strB    = strTemp
  410.  
  411. End Sub
  412.  
  413. '********************************************************************
  414. '*
  415. '* Function FormatTime()
  416. '*
  417. '* Purpose: Converts milliseconds to Hour:Min:Sec format.
  418. '*
  419. '* Input:   lngMillSecs - number of milliseconds
  420. '*
  421. '* Output:  Returns time elapsed in Hour:Min:Sec format.
  422. '*
  423. '********************************************************************
  424. Private Function FormatTime(lngMillSecs)
  425.     Dim lngHour, lngMin, lngSec
  426.     Dim strVal
  427.  
  428.     lngHour = Int(lngMillSecs / (60 * 60 * 1000))
  429.     lngMin  = Int(lngMillSecs / (60 * 1000) - lngHour * 60)
  430.     lngSec  = Int(lngMillSecs / 1000 - (lngMin * 60 + (60 * 60) * lngHour))
  431.  
  432.     FormatTime = lngHour
  433.  
  434.     If lngMin < 10 Then
  435.         strVal = "0" & lngMin
  436.     Else
  437.         strVal = CStr(lngMin)
  438.     End If
  439.     FormatTime = FormatTime & ":" & strVal
  440.  
  441.     If lngSec < 10 Then
  442.         strVal = "0" & lngSec
  443.     Else
  444.         strVal = CStr(lngSec)
  445.     End If
  446.     FormatTime = FormatTime & ":" & strVal
  447.  
  448. End Function
  449.  
  450. '********************************************************************
  451. '*
  452. '* Function strPackString()
  453. '*
  454. '* Purpose: Attaches spaces to a string to increase the length to intWidth.
  455. '*
  456. '* Input:   strString   a string
  457. '*          intWidth    the intended length of the string
  458. '*          blnAfter    Should spaces be added after the string?
  459. '*          blnTruncate specifies whether to truncate the string or not if
  460. '*                      the string length is longer than intWidth
  461. '*
  462. '* Output:  strPackString is returned as the packed string.
  463. '*
  464. '********************************************************************
  465. Private Function strPackString( ByVal strString, _
  466.                                 ByVal intWidth,  _
  467.                                 ByVal blnAfter,  _
  468.                                 ByVal blnTruncate)
  469.  
  470.     ON ERROR RESUME NEXT
  471.  
  472.     intWidth      = CInt(intWidth)
  473.     blnAfter      = CBool(blnAfter)
  474.     blnTruncate   = CBool(blnTruncate)
  475.  
  476.     If Err.Number Then
  477.         Call Wscript.Echo ("Argument type is incorrect!")
  478.         Err.Clear
  479.         Wscript.Quit
  480.     End If
  481.  
  482.     If IsNull(strString) Then
  483.         strPackString = "null" & Space(intWidth-4)
  484.         Exit Function
  485.     End If
  486.  
  487.     strString = CStr(strString)
  488.     If Err.Number Then
  489.         Call Wscript.Echo ("Argument type is incorrect!")
  490.         Err.Clear
  491.         Wscript.Quit
  492.     End If
  493.  
  494.     If intWidth > Len(strString) Then
  495.         If blnAfter Then
  496.             strPackString = strString & Space(intWidth-Len(strString))
  497.         Else
  498.             strPackString = Space(intWidth-Len(strString)) & strString & " "
  499.         End If
  500.     Else
  501.         If blnTruncate Then
  502.             strPackString = Left(strString, intWidth-1) & " "
  503.         Else
  504.             strPackString = strString & " "
  505.         End If
  506.     End If
  507.  
  508. End Function
  509.  
  510. '********************************************************************
  511. '* 
  512. '*  Function blnGetArg()
  513. '*
  514. '*  Purpose: Helper to intParseCmdLine()
  515. '* 
  516. '*  Usage:
  517. '*
  518. '*     Case "/s" 
  519. '*       blnGetArg ("server name", strServer, intArgIter)
  520. '*
  521. '********************************************************************
  522. Private Function blnGetArg ( ByVal StrVarName,   _
  523.                              ByRef strVar,       _
  524.                              ByRef intArgIter) 
  525.  
  526.     blnGetArg = False 'failure, changed to True upon successful completion
  527.  
  528.     If Len(Wscript.Arguments(intArgIter)) > 2 then
  529.         If Mid(Wscript.Arguments(intArgIter),3,1) = ":" then
  530.             If Len(Wscript.Arguments(intArgIter)) > 3 then
  531.                 strVar = Right(Wscript.Arguments(intArgIter), _
  532.                          Len(Wscript.Arguments(intArgIter)) - 3)
  533.                 blnGetArg = True
  534.                 Exit Function
  535.             Else
  536.                 intArgIter = intArgIter + 1
  537.                 If intArgIter > (Wscript.Arguments.Count - 1) Then
  538.                     Call Wscript.Echo( "Invalid " & StrVarName & ".")
  539.                     Call Wscript.Echo( "Please check the input and try again.")
  540.                     Exit Function
  541.                 End If
  542.  
  543.                 strVar = Wscript.Arguments.Item(intArgIter)
  544.                 If Err.Number Then
  545.                     Call Wscript.Echo( "Invalid " & StrVarName & ".")
  546.                     Call Wscript.Echo( "Please check the input and try again.")
  547.                     Exit Function
  548.                 End If
  549.  
  550.                 If InStr(strVar, "/") Then
  551.                     Call Wscript.Echo( "Invalid " & StrVarName)
  552.                     Call Wscript.Echo( "Please check the input and try again.")
  553.                     Exit Function
  554.                 End If
  555.  
  556.                 blnGetArg = True 'success
  557.             End If
  558.         Else
  559.             strVar = Right(Wscript.Arguments(intArgIter), _
  560.                      Len(Wscript.Arguments(intArgIter)) - 2)
  561.             blnGetArg = True 'success
  562.             Exit Function
  563.         End If
  564.     Else
  565.         intArgIter = intArgIter + 1
  566.         If intArgIter > (Wscript.Arguments.Count - 1) Then
  567.             Call Wscript.Echo( "Invalid " & StrVarName & ".")
  568.             Call Wscript.Echo( "Please check the input and try again.")
  569.             Exit Function
  570.         End If
  571.  
  572.         strVar = Wscript.Arguments.Item(intArgIter)
  573.         If Err.Number Then
  574.             Call Wscript.Echo( "Invalid " & StrVarName & ".")
  575.             Call Wscript.Echo( "Please check the input and try again.")
  576.             Exit Function
  577.         End If
  578.  
  579.         If InStr(strVar, "/") Then
  580.             Call Wscript.Echo( "Invalid " & StrVarName)
  581.             Call Wscript.Echo( "Please check the input and try again.")
  582.             Exit Function
  583.         End If
  584.         blnGetArg = True 'success
  585.     End If
  586. End Function
  587.  
  588. '********************************************************************
  589. '*
  590. '* Function blnConnect()
  591. '*
  592. '* Purpose: Connects to machine strServer.
  593. '*
  594. '* Input:   strServer       a machine name
  595. '*          strNameSpace    a namespace
  596. '*          strUserName     name of the current user
  597. '*          strPassword     password of the current user
  598. '*
  599. '* Output:  objService is returned  as a service object.
  600. '*          strServer is set to local host if left unspecified
  601. '*
  602. '********************************************************************
  603. Private Function blnConnect(ByVal strNameSpace, _
  604.                             ByVal strUserName,  _
  605.                             ByVal strPassword,  _
  606.                             ByRef strServer,    _
  607.                             ByRef objService)
  608.  
  609.     ON ERROR RESUME NEXT
  610.  
  611.     Dim objLocator, objWshNet
  612.  
  613.     blnConnect = False     'There is no error.
  614.  
  615.     'Create Locator object to connect to remote CIM object manager
  616.     Set objLocator = CreateObject("WbemScripting.SWbemLocator")
  617.     If Err.Number then
  618.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & _
  619.                            " occurred in creating a locator object." )
  620.         If Err.Description <> "" Then
  621.             Call Wscript.Echo( "Error description: " & Err.Description & "." )
  622.         End If
  623.         Err.Clear
  624.         blnConnect = True     'An error occurred
  625.         Exit Function
  626.     End If
  627.  
  628.     'Connect to the namespace which is either local or remote
  629.     Set objService = objLocator.ConnectServer (strServer, strNameSpace, _
  630.        strUserName, strPassword)
  631.     ObjService.Security_.impersonationlevel = 3
  632.     If Err.Number then
  633.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & _
  634.                            " occurred in connecting to server " _
  635.            & strServer & ".")
  636.         If Err.Description <> "" Then
  637.             Call Wscript.Echo( "Error description: " & Err.Description & "." )
  638.         End If
  639.         Err.Clear
  640.         blnConnect = True     'An error occurred
  641.     End If
  642.  
  643.     'Get the current server's name if left unspecified
  644.     If IsEmpty(strServer) Then
  645.         Set objWshNet = CreateObject("Wscript.Network")
  646.     strServer     = objWshNet.ComputerName
  647.     End If
  648.  
  649. End Function
  650.  
  651. '********************************************************************
  652. '*
  653. '* Sub      VerifyHostIsCscript()
  654. '*
  655. '* Purpose: Determines which program is used to run this script.
  656. '*
  657. '* Input:   None
  658. '*
  659. '* Output:  If host is not cscript, then an error message is printed 
  660. '*          and the script is aborted.
  661. '*
  662. '********************************************************************
  663. Sub VerifyHostIsCscript()
  664.  
  665.     ON ERROR RESUME NEXT
  666.  
  667.     Dim strFullName, strCommand, i, j, intStatus
  668.  
  669.     strFullName = WScript.FullName
  670.  
  671.     If Err.Number then
  672.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & " occurred." )
  673.         If Err.Description <> "" Then
  674.             Call Wscript.Echo( "Error description: " & Err.Description & "." )
  675.         End If
  676.         intStatus =  CONST_ERROR
  677.     End If
  678.  
  679.     i = InStr(1, strFullName, ".exe", 1)
  680.     If i = 0 Then
  681.         intStatus =  CONST_ERROR
  682.     Else
  683.         j = InStrRev(strFullName, "\", i, 1)
  684.         If j = 0 Then
  685.             intStatus =  CONST_ERROR
  686.         Else
  687.             strCommand = Mid(strFullName, j+1, i-j-1)
  688.             Select Case LCase(strCommand)
  689.                 Case "cscript"
  690.                     intStatus = CONST_CSCRIPT
  691.                 Case "wscript"
  692.                     intStatus = CONST_WSCRIPT
  693.                 Case Else       'should never happen
  694.                     Call Wscript.Echo( "An unexpected program was used to " _
  695.                                        & "run this script." )
  696.                     Call Wscript.Echo( "Only CScript.Exe or WScript.Exe can " _
  697.                                        & "be used to run this script." )
  698.                     intStatus = CONST_ERROR
  699.                 End Select
  700.         End If
  701.     End If
  702.  
  703.     If intStatus <> CONST_CSCRIPT Then
  704.         Call WScript.Echo( "Please run this script using CScript." & vbCRLF & _
  705.              "This can be achieved by" & vbCRLF & _
  706.              "1. Using ""CScript PSTop arguments"" for Windows 95/98 or" _
  707.              & vbCRLF & "2. Changing the default Windows Scripting Host " _
  708.              & "setting to CScript" & vbCRLF & "    using ""CScript " _
  709.              & "//H:CScript //S"" and running the script using" & vbCRLF & _
  710.              "    ""PSTop arguments"" for Windows NT/2000." )
  711.         WScript.Quit
  712.     End If
  713.  
  714. End Sub
  715.  
  716. '********************************************************************
  717. '*
  718. '* Sub WriteLine()
  719. '* Purpose: Writes a text line either to a file or on screen.
  720. '* Input:   strMessage  the string to print
  721. '*          objFile     an output file object
  722. '* Output:  strMessage is either displayed on screen or written to a file.
  723. '*
  724. '********************************************************************
  725. Sub WriteLine(ByVal strMessage, ByVal objFile)
  726.  
  727.     On Error Resume Next
  728.     If IsObject(objFile) then        'objFile should be a file object
  729.         objFile.WriteLine strMessage
  730.     Else
  731.         Call Wscript.Echo( strMessage )
  732.     End If
  733.  
  734. End Sub
  735.  
  736. '********************************************************************
  737. '* 
  738. '* Function blnErrorOccurred()
  739. '*
  740. '* Purpose: Reports error with a string saying what the error occurred in.
  741. '*
  742. '* Input:   strIn        string saying what the error occurred in.
  743. '*
  744. '* Output:  displayed on screen 
  745. '* 
  746. '********************************************************************
  747. Private Function blnErrorOccurred (ByVal strIn)
  748.  
  749.     If Err.Number Then
  750.         Call Wscript.Echo( "Error 0x" & CStr(Hex(Err.Number)) & ": " & strIn)
  751.         If Err.Description <> "" Then
  752.             Call Wscript.Echo( "Error description: " & Err.Description)
  753.         End If
  754.         Err.Clear
  755.         blnErrorOccurred = True
  756.     Else
  757.         blnErrorOccurred = False
  758.     End If
  759.  
  760. End Function
  761.  
  762. '********************************************************************
  763. '* 
  764. '* Function blnOpenFile
  765. '*
  766. '* Purpose: Opens a file.
  767. '*
  768. '* Input:   strFileName        A string with the name of the file.
  769. '*
  770. '* Output:  Sets objOpenFile to a FileSystemObject and setis it to 
  771. '*            Nothing upon Failure.
  772. '* 
  773. '********************************************************************
  774. Private Function blnOpenFile(ByVal strFileName, ByRef objOpenFile)
  775.  
  776.     ON ERROR RESUME NEXT
  777.  
  778.     Dim objFileSystem
  779.  
  780.     Set objFileSystem = Nothing
  781.  
  782.     If IsEmpty(strFileName) OR strFileName = "" Then
  783.         blnOpenFile = False
  784.         Set objOpenFile = Nothing
  785.         Exit Function
  786.     End If
  787.  
  788.     'Create a file object
  789.     Set objFileSystem = CreateObject("Scripting.FileSystemObject")
  790.     If blnErrorOccurred("Could not create filesystem object.") Then
  791.         blnOpenFile = False
  792.         Set objOpenFile = Nothing
  793.         Exit Function
  794.     End If
  795.  
  796.     'Open the file for output
  797.     Set objOpenFile = objFileSystem.OpenTextFile(strFileName, 8, True)
  798.     If blnErrorOccurred("Could not open") Then
  799.         blnOpenFile = False
  800.         Set objOpenFile = Nothing
  801.         Exit Function
  802.     End If
  803.     blnOpenFile = True
  804.  
  805. End Function
  806.  
  807. '********************************************************************
  808. '*                                                                  *
  809. '*                           End of File                            *
  810. '*                                                                  *
  811. '********************************************************************
  812.