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