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