By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
438,162 Members | 1,038 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 438,162 IT Pros & Developers. It's quick & easy.

writeline - Invalid procedure cal or argument

P: 1
Running a vbscript that is supposed to complete series of process checks and write the results to a text file. The script runs fine on windows 2003 server but on the new Windows 2008 R2 get the following error:

Line: 409
Char: 6
Error: Invalid procedure call or argument
Code: 800A0005
Source: Microsoft VBScript runtime error

Here is the line of code with the error:

Expand|Select|Wrap|Line Numbers
  1. objTextFile.WriteLine(status & " " & FormatDate(Now(), "%a %d %H:%M:%S %Y") & " " & host & vbCrLf & message)
  2.  
  3.  
  4. Here is the entire script
  5.  
  6. <job id="BitechCheck">
  7.   <script language="VBScript" src="Config.vbs"/>
  8.   <script language="VBScript" src="Registry.vbs"/>
  9.   <script language="VBScript" src="Process.vbs"/>
  10.   <script language="VBScript" src="MSMQTests.vbs"/>
  11.   <script language="VBScript" src="Computer.vbs"/>
  12.   <script language="VBScript">
  13.   Option Explicit
  14.  
  15.   'On Error Resume Next
  16.  
  17.   Function outputTag(mytest, state, mesg)
  18.       outputTag = "  <output test=""" & mytest & """ state=""" & state & """>" & vbCrLf & mesg & "  </output>" & vbCrLf
  19.   End Function
  20.  
  21.   Function BuildSimpleMessage(mesg)
  22.     BuildSimpleMessage = "    <SM>" & mesg & "</SM>" & vbCrLf
  23.   End Function
  24.  
  25.   Function BuildMultiMessage(ByRef mmDict)
  26.     Dim strRow, row, key
  27.     strRow = "    <MM>" & vbCrLf
  28.     For Each row In mmDict.Keys
  29.       If mmDict.Item(row).Exists("params") Then
  30.         strRow = strRow & "      <row index=""" & row & """" & mmDict.Item(row).Item("params") & ">" & vbCrLf
  31.       Else
  32.         strRow = strRow & "      <row index=""" & row & """>" & vbCrLf
  33.       End If
  34.       For Each key In mmDict.Item(row).Keys
  35.         If Left(key, 3) = "col" Then
  36.           If mmDict.Item(row).Item(key).Exists("params") Then
  37.             strRow = strRow & "        <col " & mmDict.Item(row).Item(key).Item("params") & ">" & mmDict.Item(row).Item(key).Item("data") & "</col>" & vbCrLf
  38.           Else
  39.             strRow = strRow & "        <col>" & mmDict.Item(row).Item(key).Item("data") & "</col>" & vbCrLf
  40.           End If 
  41.         End If
  42.       Next
  43.       strRow = strRow & "      </row>" & vbCrLf
  44.     Next
  45.     strRow = strRow & "    </MM>" & vbCrLf
  46.     BuildMultiMessage = strRow
  47.   End Function
  48.  
  49.   Function BitechLoggingInfo(ByRef objRegistry, ByRef myconfig)
  50.     Dim dwEnabled, strResult, mmDict, module, rk
  51.     Dim objModuleDict
  52.  
  53.     rk = Split(myconfig.TestParam("Tracing", "rkEnable"),",")
  54.  
  55. 'WScript.Echo ("Received: " & rk(0) & "-" & rk(1) & "-" & rk(2))
  56.     If Not(objRegistry.DoesKeyExist(rk(0),rk(1),rk(2))) Then
  57.       strResult = outputTag("Bi-Tech TRACING", "green", BuildSimpleMessage("Tracing is Disabled"))
  58.     Else
  59.       dwEnabled = objRegistry.ReadDWORDVal(rk(0), rk(1), rk(2))
  60.  
  61.       If dwEnabled > 0 Then
  62.         strResult = outputTag("Bi-Tech TRACING", "yellow", BuildSimpleMessage("Tracing is Enabled"))
  63.         ' Get all Module subkeys that are enabled (ie > 0)
  64.         ' Allowable types for GetSubValuesBy Type Function REG_SZ, REG_EXPAND_SZ, REG_BINARY, REG_DWORD, REG_MULTI_SZ
  65.          rk = Split(myconfig.TestParam("Tracing", "rkModuleSubKey"),",")
  66. 'WScript.Echo ("Received: " & rk(0) & "-" & rk(1))
  67.          Set objModuleDict = objRegistry.GetSubValuesByType(rk(0),rk(1),"REG_DWORD")
  68.  
  69.          Set mmDict = CreateObject("Scripting.Dictionary")
  70.          mmDict.Add "Header", CreateObject("Scripting.Dictionary")
  71.          mmDict.Item("Header").Add "col1", CreateObject("Scripting.Dictionary")
  72.          mmDict.Item("Header").Item("col1").Add "data", "Module"
  73.          mmDict.Item("Header").Add "col2", CreateObject("Scripting.Dictionary")
  74.          mmDict.Item("Header").Item("col2").Add "data", "Setting"
  75.  
  76.  
  77.          Dim i: i=0
  78.          For Each module In objModuleDict.Keys
  79.            If objModuleDict.Item(module) > 0 Then
  80.              'WScript.Echo "HERE " & i & " MoD " & module
  81.              mmDict.Add i, CreateObject("Scripting.Dictionary")
  82.              mmDict.Item(i).Add "col1", CreateObject("Scripting.Dictionary")
  83.              mmDict.Item(i).Item("col1").Add "data", module
  84.              mmDict.Item(i).Item("col1").Add "params", "state=""yellow"""
  85.              mmDict.Item(i).Add "col2", CreateObject("Scripting.Dictionary")
  86.              mmDict.Item(i).Item("col2").Add "data", objModuleDict.Item(module)
  87.              mmDict.Item(i).Item("col2").Add "params", "state=""yellow"""             
  88.              i = i+1
  89.            End If
  90.          Next
  91.          strResult = strResult & outputTag("Enabled Modules", "yellow", BuildMultiMessage(mmDict))
  92.       Else
  93.         strResult = outputTag("Bi-Tech TRACING", "green", BuildSimpleMessage("Tracing is Disabled"))
  94.       End If
  95.     End If
  96.     BitechLoggingInfo = strResult
  97.   End Function
  98.  
  99.   Function BitechVersionInfo(ByRef objRegistry, ByRef myconfig)
  100.     Dim expectedVersion, version, status, app, rk, mmDict
  101.     rk = Split(myconfig.TestParam("Version", "rkVersion"),",")
  102.  
  103.     'Every 7i server should have screens at the very least
  104.     status = "green"
  105.     If Not(objRegistry.DoesKeyExist(rk(0),rk(1),rk(2))) Then
  106.       BitechVersionInfo = outputTag("Version Info", status, BuildSimpleMessage("This is not a properly configured 7i server"))
  107.       Exit Function
  108.     End If
  109.  
  110.     expectedVersion = objRegistry.ReadStrVal(rk(0),rk(1),rk(2))
  111.  
  112.     Set mmDict = CreateObject("Scripting.Dictionary")
  113.     mmDict.Add "Header", CreateObject("Scripting.Dictionary")
  114.     mmDict.Item("Header").Add "col1", CreateObject("Scripting.Dictionary")
  115.     mmDict.Item("Header").Item("col1").Add "data", "PRODUCT"
  116.     mmDict.Item("Header").Add "col2", CreateObject("Scripting.Dictionary")
  117.     mmDict.Item("Header").Item("col2").Add "data", "VERSION"
  118.  
  119.     Dim i : i=0
  120.     For Each app In (myconfig.BitechApps())
  121.       rk = Split(myconfig.TestParam("Version", "rkAppVersion"),",")
  122. 'WScript.Echo "rkAppVersion: " & rk(0) & "-" & rk(1) & app & "-" & rk(2)
  123.       If objRegistry.DoesKeyExist(rk(0),rk(1) & app, rk(2)) Then
  124.         version = objRegistry.ReadStrVal(rk(0),rk(1) & app, rk(2))
  125. 'WScript.Echo "HERE " & i & " App: " & app & " Version: " & version
  126.         mmDict.Add i, CreateObject("Scripting.Dictionary")
  127.         mmDict.Item(i).Add "col1", CreateObject("Scripting.Dictionary")
  128.         mmDict.Item(i).Item("col1").Add "data", app
  129.         mmDict.Item(i).Add "col2", CreateObject("Scripting.Dictionary")
  130.         mmDict.Item(i).Item("col2").Add "data", version
  131.  
  132.         If (version = expectedVersion) OR (app = "OPENLINK") Then
  133.           mmDict.Item(i).Item("col1").Add "params", "state=""green"""
  134.           mmDict.Item(i).Item("col2").Add "params", "state=""green"""
  135.         Else
  136.           status = "red"
  137.           mmDict.Item(i).Item("col1").Add "params", "state=""red"""
  138.           mmDict.Item(i).Item("col2").Add "params", "state=""red"""
  139.         End If
  140.         i = i+1
  141.       End If
  142.     Next
  143.     BitechVersionInfo = outputTag("Version Info", status, BuildMultiMessage(mmDict))
  144.   End Function
  145.  
  146.   ' Later could add a function in XML_Handler to do a Post like this
  147.   ' and reduce the number of lines and check in this call
  148.   ' Call might be xml_cls.PostXML(url, xmlRequest, recvTimeout, errArray(timeout_err, communication_err, resp_parse_err))
  149.   Function BitechLogin_Check(ByRef myconfig)
  150.     Dim xmlRequest, xmlHTTP, xmlDoc, respNode
  151.     Dim receiveTimeout
  152.     Dim sReq : sReq = myconfig.TestParam("Login", "xmlconnect")
  153.  
  154.     set xmlRequest = createObject("MSXML2.DOMDocument")
  155.     xmlRequest.async = false
  156.  
  157.     If xmlRequest.loadXML(sReq) Then
  158.       set xmlHTTP=createObject("MSXML2.ServerXMLHTTP")
  159.       xmlHTTP.open "POST","http://localhost/ifas7/isapi/btwebrqb.dll", True
  160.       xmlHTTP.send(xmlRequest)
  161.  
  162.       'Turn off errors because don't want script to die if response is bad.
  163.       On Error Resume Next
  164.  
  165.       'Wait for a response for a configurable amount of time
  166.       receiveTimeout = myconfig.TestParam("Login", "receiveTimeout")
  167.       If xmlHTTP.readyState <> 4 then
  168.         Call xmlHTTP.waitForResponse(receiveTimeout)
  169.       End If
  170.  
  171.       'Check for timeout error
  172.       If Err.Number <> 0 then
  173.         BitechLogin_Check = outputTag("Login Test", "red", BuildSimpleMessage("Error: Login Timeout reached"))
  174.       Else
  175.         If (xmlHTTP.readyState <> 4) Or (xmlHTTP.Status <> 200) Then
  176.           BitechLogin_Check = outputTag("Login Test", "red", BuildSimpleMessage("Error: Problem communicating with server: XML Status: " & xmlHTTP.readyState & " HTTP status: " & xmlHTTP.Status))
  177.           'Abort the XMLHttp request
  178.           xmlHTTP.Abort
  179.         Else
  180.             Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  181.             xmlDoc.loadXML xmlHTTP.responseText
  182.             If xmlDoc.parseError.errorCode <> 0 Then
  183.               BitechLogin_Check = outputTag("Login Test", "red", BuildSimpleMessage("Could not parse login response, 7i probably down!"))
  184.             Else 'Got a response
  185.               Set respNode = xmlDoc.getElementsByTagName("Response")(0).firstChild
  186.               If respNode.nodeName = "LoginError" Then
  187.                 BitechLogin_Check = outputTag("Login Test", "red", BuildSimpleMessage("Login Error: " & respNode.firstChild.nodeValue))
  188.               Else
  189.                 BitechLogin_Check = outputTag("Login Test", "green", BuildSimpleMessage("Login Successful"))
  190.               End If
  191.             End If 
  192.         End If
  193.       End If
  194.     Else
  195.      BitechLogin_Check = outputTag("Login Test", "red", BuildSimpleMessage("Could not load login test XML"))
  196.     End If
  197.   End Function
  198.  
  199.   Function MSMQMesgTest(ByRef msmqt, ByRef myconfig)
  200.     Dim mmDict, queue, status
  201.     Set mmDict = CreateObject("Scripting.Dictionary")
  202.     mmDict.Add "Header", CreateObject("Scripting.Dictionary")
  203.     mmDict.Item("Header").Add "col1", CreateObject("Scripting.Dictionary")
  204.     mmDict.Item("Header").Item("col1").Add "data", "Queue"
  205.     mmDict.Item("Header").Add "col2", CreateObject("Scripting.Dictionary")
  206.     mmDict.Item("Header").Item("col2").Add "data", "Message Count"
  207.     mmDict.Item("Header").Add "col3", CreateObject("Scripting.Dictionary")
  208.     mmDict.Item("Header").Item("col3").Add "data", "Queue Bytes"
  209.     mmDict.Item("Header").Add "col4", CreateObject("Scripting.Dictionary")
  210.     mmDict.Item("Header").Item("col4").Add "data", "Quota KBytes"
  211.  
  212.     Dim i : i = 0
  213.     For Each queue In msmqt.GetPrivateQueues()
  214.       msmqt.QueueName = queue
  215.  
  216.       mmDict.Add i, CreateObject("Scripting.Dictionary")
  217.       mmDict.Item(i).Add "col1", CreateObject("Scripting.Dictionary")
  218.       mmDict.Item(i).Item("col1").Add "data", queue
  219.       mmDict.Item(i).Add "col2", CreateObject("Scripting.Dictionary")
  220.       mmDict.Item(i).Add "col3", CreateObject("Scripting.Dictionary")
  221.       mmDict.Item(i).Add "col4", CreateObject("Scripting.Dictionary")
  222.  
  223.       If Err.Number <> 0 Then
  224.         If Err.Number = -1072824316 Then
  225.           ' Later might want to actually check which problem exists
  226.           ' Does the queue not exist, or is it not open?
  227.           ' Most likely not open, or it would not get to this point.
  228.           mmDict.Item(i).Item("col2").Add "data", Err.Description
  229.           mmDict.Item(i).Item("col2").Add "params", "state=""green"""
  230.           mmDict.Item(i).Item("col3").Add "data", "Error"
  231.           mmDict.Item(i).Item("col3").Add "params", "state=""green"""
  232.           mmDict.Item(i).Item("col4").Add "data", "Error"
  233.           mmDict.Item(i).Item("col4").Add "params", "state=""green"""
  234.           status = "green"
  235.         Else
  236.           mmDict.Item(i).Item("col2").Add "data", Err.Description
  237.           mmDict.Item(i).Item("col2").Add "params", "state=""yellow"""
  238.           mmDict.Item(i).Item("col3").Add "data", "Error"
  239.           mmDict.Item(i).Item("col3").Add "params", "state=""yellow"""
  240.           mmDict.Item(i).Item("col4").Add "data", "Error"
  241.           mmDict.Item(i).Item("col4").Add "params", "state=""yellow"""
  242.           status = "yellow"
  243.         End If
  244.         Err.Clear
  245.       Else
  246.         Dim qcount : qcount = msmqt.GetQueueMsgCount()
  247.         mmDict.Item(i).Item("col2").Add "data", qcount
  248.         Dim msgy : msgy = 0 + myconfig.TestParam("MSMQ", "msgcounty")
  249.         Dim msgr : msgr = 0 + myconfig.TestParam("MSMQ", "msgcountr")
  250.  
  251.         'Test message counts
  252.         If qcount > msgr Then
  253.           mmDict.Item(i).Item("col2").Add "params", "state=""red"""
  254.           status = "red"
  255.         Else
  256.           If qcount > msgy Then
  257.             mmDict.Item(i).Item("col2").Add "params", "state=""yellow"""
  258.             status = "yellow"
  259.           Else
  260.             mmDict.Item(i).Item("col2").Add "params", "state=""green"""
  261.             status = "green"
  262.           End If
  263.         End If
  264.  
  265.         Dim qbytes : qbytes = CLng(msmqt.GetQueueBytes())
  266.         mmDict.Item(i).Item("col3").Add "data", CStr(msmqt.GetQueueBytes())
  267.         msgy = CLng( myconfig.TestParam("MSMQ", "msgbytesy") )
  268.         msgr = CLng( myconfig.TestParam("MSMQ", "msgbytesr") )
  269.  
  270.         'Test Byte sizes
  271.         If qbytes  > msgr Then
  272.           mmDict.Item(i).Item("col3").Add "params", "state=""red"""
  273.           status = "red"
  274.         Else
  275.           If qbytes  > msgy Then
  276.             mmDict.Item(i).Item("col3").Add "params", "state=""yellow"""
  277.             status = "yellow"
  278.           Else
  279.             mmDict.Item(i).Item("col3").Add "params", "state=""green"""
  280.             status = "green"
  281.           End If
  282.         End If
  283.  
  284.         Dim qquota : qquota = CLng(msmqt.GetQueueQuota()) * 1024
  285.         mmDict.Item(i).Item("col4").Add "data", CStr(msmqt.GetQueueQuota())
  286.         msgy = CLng( myconfig.TestParam("MSMQ", "msgquotay") )
  287.         msgr = CLng( myconfig.TestParam("MSMQ", "msgquotar") )
  288.  
  289.         'Test if quota was violated
  290.         ' msgr and msgy hold the number of bytes below the qquota threshold
  291.         ' that triggers a red or yellow alert.  For example, if the queue quota
  292.         ' is 4096 bytes qbytes would have to be grater then 4096 - msgr to trigger a red alert.
  293.         If (qbytes  > (qquota - msgr)) And (qquota <> -1024) Then
  294.           mmDict.Item(i).Item("col4").Add "params", "state=""red"""
  295.           status = "red"
  296.         Else
  297.           If (qbytes  > (qquota - msgy)) And (qquota <> -1024) Then
  298.             mmDict.Item(i).Item("col4").Add "params", "state=""yellow"""
  299.             status = "yellow"
  300.           Else
  301.             mmDict.Item(i).Item("col4").Add "params", "state=""green"""
  302.             status = "green"
  303.           End If
  304.         End If
  305.       End If
  306.       i = i + 1
  307.     Next
  308.     MSMQMesgTest = outputTag("MSMQ Count", status, BuildMultiMessage(mmDict))
  309.   End Function
  310.  
  311.   Function BitechWFp_check(ByRef objProcess, ByRef myconfig)
  312.     Dim confignum : confignum = myconfig.TestParam("WFproc", "numprocs")
  313. 'WScript.Echo "WF processes: " & myconfig.TestParam("WFproc", "wfengproc") & "-" & myconfig.TestParam("WFproc", "wfsvcproc")
  314.     BitechWFp_check = (objProcess.IsProcessActive(myconfig.TestParam("WFproc", "wfengproc"), confignum, "=") AND _
  315.                        objProcess.IsProcessActive(myconfig.TestParam("WFproc", "wfsvcproc"), confignum, "="))
  316.   End Function
  317.  
  318.   Function Bitech7ip_check(ByRef objProcess, ByRef myconfig)
  319. 'WScript.Echo "BTQMH processes: " & myconfig.TestParam("BTMQHproc", "btmqhproc")
  320.     Bitech7ip_check = objProcess.IsProcessActive(myconfig.TestParam("BTMQHproc", "btmqhproc"), myconfig.TestParam("BTMQHproc", "numprocs"), "=")
  321.   End Function
  322.  
  323.   Function BitechCDDp_check(ByRef objProcess, ByRef objRegistry, ByRef myconfig)
  324.     Dim numCDD, rk
  325.     rk = Split(myconfig.TestParam("CDDproc", "rkCDDMax"),",")
  326. 'WScript.Echo "rkCDDMax: " & rk(0) & "-" & rk(1) & "-" & rk(2)
  327.     If objRegistry.DoesKeyExist(rk(0),rk(1),rk(2)) Then
  328.       numCDD = objRegistry.ReadDWORDVal(rk(0),rk(1),rk(2))
  329. 'WScript.Echo "Key existed: " & numCDD
  330. 'WScript.Echo "CDD proc: " & myconfig.TestParam("CDDproc", "cddproc")
  331.       'BitechCDDp_check = objProcess.IsProcessActive(myconfig.TestParam("CDDproc", "cddproc"), numCDD, ">=")
  332.     Else
  333.       'If the key isn't defined typically 4 is the default max instances
  334.       'BitechCDDp_check = objProcess.IsProcessActive(myconfig.TestParam("CDDproc", "cddproc"), myconfig.TestParam("CDDproc", "numprocs"), ">=")
  335.       numCDD = myconfig.TestParam("CDDproc", "numprocs")
  336.     End If
  337.  
  338.     BitechCDDp_check = 0
  339.     If objProcess.IsProcessActive(myconfig.TestParam("CDDproc", "cddproc"), numCDD * myconfig.TestParam("CDDproc", "numprocsy"), "<=") Then
  340.       BitechCDDp_check = 1
  341.     End If
  342.     If objProcess.IsProcessActive(myconfig.TestParam("CDDproc", "cddproc"), numCDD * myconfig.TestParam("CDDproc", "numprocsr"), "<=") Then
  343.       BitechCDDp_check = 2
  344.     End If
  345.   End Function
  346.  
  347.   Sub FillmmDict(ByRef objProcess, ByRef mmDict, col, myfunction, params, thresholds)
  348.     Dim state
  349.     Dim pt, i
  350.     Dim ptempArr: ptempArr = Eval("objProcess." & myfunction & "(" & params & ")")
  351.  
  352.     If Not(IsNull(ptempArr)) Then
  353.       i = 0
  354.       For Each pt In ptempArr
  355.         state = "green"
  356.         If Not(IsNull(thresholds)) Then
  357.           If pt >= (0 + thresholds.Item("YELLOW")) Then
  358.             state = "yellow"
  359.           End If
  360.           If pt >= (0 + thresholds.Item("RED")) Then
  361.             state = "red"
  362.           End If
  363.         End If
  364.  
  365.         If Not(mmDict.Exists(i)) Then
  366.           mmDict.Add i, CreateObject("Scripting.Dictionary")
  367.         End If
  368.         mmDict.Item(i).Add col, CreateObject("Scripting.Dictionary")
  369.         mmDict.Item(i).Item(col).Add "data", pt
  370.         mmDict.Item(i).Item(col).Add "params", "state=""" & state & """"
  371.  
  372.         i = i + 1
  373.       Next
  374.     End If
  375.   End Sub
  376.  
  377.   Sub CreateBBLog(host, status, strDirectory, strFile_in, message)
  378.     Dim objFSO, objFolder, objShell, objTextFile, objFile
  379.     Dim strFile
  380.  
  381.     'Temp file
  382.     strFile = "tmpfile.txt"
  383.  
  384.     ' Create the File System Object
  385.     Set objFSO = CreateObject("Scripting.FileSystemObject")
  386.  
  387.     ' Check that the strDirectory folder exists
  388.     If objFSO.FolderExists(strDirectory) Then
  389.       Set objFolder = objFSO.GetFolder(strDirectory)
  390.     Else
  391.       Set objFolder = objFSO.CreateFolder(strDirectory)
  392.       'WScript.Echo "Just created " & strDirectory
  393.     End If
  394.  
  395.     If objFSO.FileExists(strDirectory & strFile) Then
  396.       Set objFolder = objFSO.GetFolder(strDirectory)
  397.     Else
  398.       Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
  399.       'Wscript.Echo "Just created " & strDirectory & strFile
  400.     End If 
  401.  
  402.     set objFile = nothing
  403.     set objFolder = nothing
  404.     ' OpenTextFile Method needs a Const value
  405.     ' ForAppending = 8 ForReading = 1, ForWriting = 2
  406.     'Const ForReading = 1
  407.     Const ForWriting= 2
  408.     'Const ForAppending = 8
  409.  
  410.     Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForWriting, True)
  411.  
  412.     ' Writes strText every time you run this VBScript
  413.     objTextFile.WriteLine(status & " " & FormatDate(Now(), "%a %d %H:%M:%S %Y") & " " & host & vbCrLf & message)
  414.     objTextFile.Close
  415.  
  416.     ' Bonus or cosmetic section to launch explorer to check file
  417.     'If err.number = vbEmpty then
  418.     '  Set objShell = CreateObject("WScript.Shell")
  419.     '  objShell.run ("Explorer" &" " & strDirectory & "\" )
  420.     'Else
  421.     '  WScript.echo "VBScript Error: " & err.number
  422.     'End If
  423.  
  424.     'Rename File
  425.  
  426. 'WScript.Echo "Renaming " & (strDirectory & strFile) &  " to " & (strDirectory & strFile_in)
  427.     objFSO.MoveFile (strDirectory & strFile), (strDirectory & strFile_in)
  428.  
  429.   End Sub
  430.  
  431.   '%m Month as a decimal no. 02
  432.   '%b Abbreviated month name Feb
  433.   '%B Full month name February
  434.   '%d Day of the month 23
  435.   '%j Day of the year 54
  436.   '%y Year without century 98
  437.   '%Y Year with century 1998
  438.   '%w Weekday as integer 5 (0 is Sunday)
  439.   '%a Abbreviated day name Fri
  440.   '%A Weekday Name Friday
  441.   '%I Hour in 12 hour format 12
  442.   '%H Hour in 24 hour format 24
  443.   '%M Minute as an integer 01
  444.   '%S Second as an integer 55
  445.   '%P AM/PM Indicator PM
  446.   '%% Actual Percent sign %%
  447.  
  448.   Function FormatDate (strDate, strFormat)
  449.  
  450.     Dim intPosItem, intHourPart, strHourPart, strMinutePart, strSecondPart, strAMPM, dp
  451.  
  452.     If not IsDate(strDate) Then
  453.       FormatDate = strDate
  454.       Exit Function
  455.     End If
  456.  
  457.     intPosItem = Instr(strFormat, "%m")
  458.     Do While intPosItem > 0
  459.       strFormat = Left(strFormat, intPosItem-1) & _
  460.                        DatePart("m",strDate) & _
  461.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  462.       intPosItem = Instr(strFormat, "%m")
  463.     Loop
  464.  
  465.     intPosItem = Instr(strFormat, "%b")
  466.     Do While intPosItem > 0
  467.       strFormat = Left(strFormat, intPosItem-1) & _
  468.                        MonthName(DatePart("m",strDate),True) & _
  469.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  470.       intPosItem = Instr(strFormat, "%b")
  471.     Loop
  472.  
  473.     intPosItem = Instr(strFormat, "%B")
  474.     Do While intPosItem > 0
  475.       strFormat = Left(strFormat, intPosItem-1) & _
  476.                        MonthName(DatePart("m",strDate),False) & _
  477.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  478.       intPosItem = Instr(strFormat, "%B")
  479.     Loop
  480.  
  481.     intPosItem = Instr(strFormat, "%d")
  482.     Do While intPosItem > 0
  483.       dp = DatePart("d",strDate)
  484.       If dp < 10 Then dp = "0" & dp
  485.       strFormat = Left(strFormat, intPosItem-1) & _
  486.                        dp & _
  487.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  488.       intPosItem = Instr(strFormat, "%d")
  489.     Loop
  490.  
  491.     intPosItem = Instr(strFormat, "%j")
  492.     Do While intPosItem > 0
  493.       strFormat = Left(strFormat, intPosItem-1) & _
  494.                        DatePart("y",strDate) & _
  495.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  496.       intPosItem = Instr(strFormat, "%j")
  497.     Loop
  498.  
  499.     intPosItem = Instr(strFormat, "%y")
  500.     Do While intPosItem > 0
  501.       strFormat = Left(strFormat, intPosItem-1) & _
  502.                        Right(DatePart("yyyy",strDate),2) & _
  503.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  504.       intPosItem = Instr(strFormat, "%y")
  505.     Loop
  506.  
  507.     intPosItem = Instr(strFormat, "%Y")
  508.     Do While intPosItem > 0
  509.       strFormat = Left(strFormat, intPosItem-1) & _
  510.                        DatePart("yyyy",strDate) & _
  511.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  512.       intPosItem = Instr(strFormat, "%Y")
  513.     Loop
  514.  
  515.     intPosItem = Instr(strFormat, "%w")
  516.     Do While intPosItem > 0
  517.       strFormat = Left(strFormat, intPosItem-1) & _
  518.                        DatePart("w",strDate,1) & _
  519.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  520.       intPosItem = Instr(strFormat, "%w")
  521.     Loop
  522.  
  523.     intPosItem = Instr(strFormat, "%a")
  524.     Do While intPosItem > 0
  525.       strFormat = Left(strFormat, intPosItem-1) & _
  526.                        WeekDayName(DatePart("w",strDate,1),True) & _
  527.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  528.         intPosItem = Instr(strFormat, "%a")
  529.     Loop
  530.  
  531.     intPosItem = Instr(strFormat, "%A")
  532.     Do While intPosItem > 0
  533.       strFormat = Left(strFormat, intPosItem-1) & _
  534.                        WeekDayName(DatePart("w",strDate,1),False) & _
  535.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  536.         intPosItem = Instr(strFormat, "%A")
  537.     Loop
  538.  
  539.     intPosItem = Instr(strFormat, "%I")
  540.     Do While intPosItem > 0
  541.       intHourPart = DatePart("h",strDate) mod 12
  542.       if intHourPart = 0 then intHourPart = 12
  543.       strFormat = Left(strFormat, intPosItem-1) & _
  544.                        intHourPart & _
  545.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  546.       intPosItem = Instr(strFormat, "%I")
  547.     Loop
  548.  
  549.     intPosItem = Instr(strFormat, "%H")
  550.     Do While intPosItem > 0
  551.       strHourPart = DatePart("h",strDate)
  552.       if strHourPart < 10 Then strHourPart = "0" & strHourPart
  553.       strFormat = Left(strFormat, intPosItem-1) & _
  554.                        strHourPart & _
  555.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  556.       intPosItem = Instr(strFormat, "%H")
  557.     Loop
  558.  
  559.     intPosItem = Instr(strFormat, "%M")
  560.     Do While intPosItem > 0
  561.       strMinutePart = DatePart("n",strDate)
  562.       if strMinutePart < 10 then strMinutePart = "0" & strMinutePart
  563.       strFormat = Left(strFormat, intPosItem-1) & _
  564.                        strMinutePart & _
  565.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  566.       intPosItem = Instr(strFormat, "%M")
  567.     Loop
  568.  
  569.     intPosItem = Instr(strFormat, "%S")
  570.     Do While intPosItem > 0
  571.       strSecondPart = DatePart("s",strDate)
  572.       if strSecondPart < 10 then strSecondPart = "0" & strSecondPart
  573.       strFormat = Left(strFormat, intPosItem-1) & _
  574.                        strSecondPart & _
  575.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  576.       intPosItem = Instr(strFormat, "%S")
  577.     Loop
  578.  
  579.     intPosItem = Instr(strFormat, "%P")
  580.     Do While intPosItem > 0
  581.       if DatePart("h",strDate) >= 12 then
  582.         strAMPM = "PM"
  583.       Else
  584.         strAMPM = "AM"
  585.       End If
  586.       strFormat = Left(strFormat, intPosItem-1) & _
  587.                        strAMPM & _
  588.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  589.       intPosItem = Instr(strFormat, "%P")
  590.     Loop
  591.  
  592.     intPosItem = Instr(strFormat, "%%")
  593.     Do While intPosItem > 0
  594.       strFormat = Left(strFormat, intPosItem-1) & "%" & _
  595.                        Right(strFormat, Len(strFormat) - (intPosItem + 1))
  596.       intPosItem = Instr(strFormat, "%%")
  597.     Loop
  598.  
  599.     FormatDate = strFormat
  600.   End Function
  601.  
  602.  
  603.   Function Reformat(vTemp)
  604.   'This function is used to replace certain chars that need to
  605.   'be converted    
  606.     If Instr(1,vtemp,"&amp;amp;apos;") Then
  607.       'Replace fixes every item in the string
  608.       vTemp = Replace(vTemp,"&amp;amp;apos;","'")
  609.       'The string "&amp;amp;apos;" must be searched for b/c the replacement
  610.       'of an apostrophe in XML is &amp;apos;, but this is not recognized
  611.       'as valid HTML so it gets interpreted as an ampersand + apos;,
  612.       'and doesn't render properly
  613.     End If
  614.  
  615.     If Instr(1,vTemp,"&amp;amp;lt;") Then
  616.       vTemp = Replace(vTemp,"&amp;amp;lt;","&amp;lt;")
  617.     End If
  618.  
  619.     If Instr(1,vTemp,"&amp;amp;gt;") Then
  620.       vTemp = Replace(vTemp,"&amp;amp;gt;","&amp;gt;")
  621.     End If 
  622.  
  623.     If Instr(1,vTemp,"&amp;amp;amp;") Then
  624.       vTemp = Replace(vTemp,"&amp;amp;amp;","&amp;amp;")
  625.     End If 
  626.  
  627.     If Instr(1,vTemp,"&amp;amp;quot;") Then
  628.       vTemp = Replace(vTemp,"&amp;amp;quot;","&amp;quot;")
  629.     End If 
  630.     Reformat = vTemp
  631.  
  632.   End Function
  633.  
  634.  
  635.   'Main Driver of Script
  636.   Sub Main()
  637.     Dim strIFAScheck, status
  638.     Dim strComputer, objWMIService, objProcess, objRegistry, myconfig, mycomputerclass
  639.     Dim objDictionary, mmDict
  640.  
  641.     'Set the computer name from the config file
  642.     Set myconfig = New Config
  643.         myconfig.ConfigFile = "configuration.xml"
  644.  
  645.     strComputer = myconfig.Hostname
  646.  
  647.     Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  648.  
  649.     ' Can not pass parameters in constructor, so create and set right after
  650.     Set objProcess = New Process
  651.         objProcess.WMIservice = objWMIService
  652.     Set objRegistry = New Registry
  653.  
  654.  
  655.     Set objDictionary = CreateObject("Scripting.Dictionary")
  656.     strIFAScheck = ""
  657.  
  658.     strIFAScheck = "<div id=""transformedxml"">" & vbCrLf
  659.     strIFAScheck = strIFAScheck & "<form name=""xmlform"" style=""display:none;visibility:hidden"">" & vbCrLf
  660.     strIFAScheck = strIFAScheck & "<textarea name=""xmltext"">" & vbCrLf
  661.     strIFAScheck = strIFAScheck & "<response host=""" & myconfig.Hostname & """ app=""" & myconfig.Checkname & """>" & vbCrLf
  662.  
  663.     'Tracing Info Check
  664.     If myconfig.TestOn("Tracing") Then
  665.       strIFAScheck  = strIFAScheck & BitechLoggingInfo(objRegistry, myconfig)
  666.     End If
  667.  
  668.     'Version Info Check
  669.     If myconfig.TestOn("Version") Then
  670.       strIFAScheck  = strIFAScheck & BitechVersionInfo(objRegistry, myconfig)
  671.     End If
  672.  
  673.     'Check for functional CDD service
  674.     If myconfig.TestOn("CDDproc") Then
  675.       Dim mycheck : mycheck = BitechCDDp_check(objProcess, objRegistry, myconfig)
  676.       If mycheck = 0 Then
  677.         strIFAScheck = strIFAScheck & outputTag("Max CDD Process Check", "green", BuildSimpleMessage("CDD Process within thresholds"))
  678.       End If
  679.       If mycheck = 1 Then
  680.         strIFAScheck = strIFAScheck & outputTag("Max CDD Process Check", "yellow", BuildSimpleMessage("More then " & myconfig.TestParam("CDDproc", "numprocsy") & "X CDD processes active."))
  681.       End If
  682.       If mycheck = 2 Then
  683.         strIFAScheck = strIFAScheck & outputTag("Max CDD Process Check", "red", BuildSimpleMessage("More then " & myconfig.TestParam("CDDproc", "numprocsr") & "X CDD processes active."))
  684.       End If
  685.     End If
  686.  
  687.     'Check for functional Workflow service
  688.     If myconfig.TestOn("WFproc") Then
  689.       If Not(BitechWFp_check(objProcess, myconfig)) Then
  690.         strIFAScheck = strIFAScheck & outputTag("Workflow Process Check", "red", BuildSimpleMessage("Workflow Service Malfunction"))
  691.       Else
  692.         strIFAScheck = strIFAScheck & outputTag("Workflow Process Check", "green", BuildSimpleMessage("Workflow Service is Stable"))
  693.       End If
  694.     End If
  695.  
  696.     'Check the login to btwebrqb
  697.     If myconfig.TestOn("Login") Then
  698.        strIFAScheck = strIFAScheck & BitechLogin_Check(myconfig)
  699.     End If
  700.  
  701.     'Check Message Queue count
  702.     If myconfig.TestOn("MSMQ") Then
  703.       Dim msmqt
  704.       Set msmqt = New MSMQTests
  705.       msmqt.MachineName = myconfig.Hostname
  706.       strIFAScheck = strIFAScheck & MSMQMesgTest(msmqt, myconfig)
  707.     End If
  708.  
  709.  
  710.     'Check for functional btqmhosts
  711.     If myconfig.TestOn("BTMQHproc") Then
  712.       If Not(Bitech7ip_check(objProcess, myconfig)) Then
  713.         strIFAScheck = strIFAScheck & outputTag("BTQMHost Process Check", "red", BuildSimpleMessage("BTQMHost(s) Process Malfunction"))
  714.       Else
  715.         strIFAScheck = strIFAScheck & outputTag("BTQMHost Process Check", "green", BuildSimpleMessage("BTQMHost(s) Process(es) are Stable"))
  716.       End If
  717.  
  718.       Set mmDict = CreateObject("Scripting.Dictionary")
  719.       mmDict.Add "Header", CreateObject("Scripting.Dictionary")
  720.       mmDict.Item("Header").Add "col1", CreateObject("Scripting.Dictionary")
  721.       mmDict.Item("Header").Item("col1").Add "data", "Proc ID"
  722.       mmDict.Item("Header").Add "col2", CreateObject("Scripting.Dictionary")
  723.       mmDict.Item("Header").Item("col2").Add "data", "~ CPU Time ~"
  724.       mmDict.Item("Header").Add "col3", CreateObject("Scripting.Dictionary")
  725.       mmDict.Item("Header").Item("col3").Add "data", "~ Mem (KB) ~"
  726.       mmDict.Item("Header").Add "col4", CreateObject("Scripting.Dictionary")
  727.       mmDict.Item("Header").Item("col4").Add "data", "~ Page File ~"
  728.       'mmDict.Item("Header").Add "col5", CreateObject("Scripting.Dictionary")
  729.       'mmDict.Item("Header").Item("col5").Add "data", "~ Page Faults ~"
  730.       mmDict.Item("Header").Add "col5", CreateObject("Scripting.Dictionary")
  731.       mmDict.Item("Header").Item("col5").Add "data", "~ Thrashing ~"
  732.       mmDict.Item("Header").Add "col6", CreateObject("Scripting.Dictionary")
  733.       mmDict.Item("Header").Item("col6").Add "data", "~ Threads ~"
  734.  
  735.       'Begin BTQMHosts table
  736.       ' When passing strings you must surround them with single quotes as done below
  737.       Dim btmqexe : btmqexe = """" & myconfig.TestParam("BTMQHproc", "btmqhproc") & """"
  738.       Call FillmmDict(objProcess, mmDict, "col1", "GetProcessID", btmqexe, null)
  739.       Call FillmmDict(objProcess, mmDict, "col2", "GetCPUTime", btmqexe, null)
  740.  
  741.       objDictionary.Add "YELLOW", myconfig.TestParam("BTMQHproc", "memkby")
  742.       objDictionary.Add "RED", myconfig.TestParam("BTMQHproc", "memkbr")
  743.       Call FillmmDict(objProcess, mmDict, "col3", "GetMemUsage", btmqexe, objDictionary)
  744.       objDictionary.RemoveAll
  745.  
  746.       objDictionary.Add "YELLOW", myconfig.TestParam("BTMQHproc", "pagefiley")
  747.       objDictionary.Add "RED", myconfig.TestParam("BTMQHproc", "pagefiler")
  748.       Call FillmmDict(objProcess, mmDict, "col4", "GetPageFileUsage", btmqexe, objDictionary)
  749.       objDictionary.RemoveAll
  750.  
  751.       'objDictionary.Add "YELLOW", myconfig.TestParam("BTMQHproc", "pagefaultsy")
  752.       'objDictionary.Add "RED", myconfig.TestParam("BTMQHproc", "pagefaultsr")
  753.       'Call FillmmDict(objProcess, mmDict, "col5", "GetPageFaults", btmqexe, objDictionary)
  754.       'objDictionary.RemoveAll
  755.  
  756.       Set mycomputerclass = New Computer
  757.         mycomputerclass.WMIservice = objWMIService
  758.  
  759.       Dim thrashparams : thrashparams = btmqexe & "," & mycomputerclass.GetAvailableMemory()
  760.       objDictionary.Add "YELLOW", 1
  761.       objDictionary.Add "RED", 1
  762.       Call FillmmDict(objProcess, mmDict, "col5", "GetThrashingResults", thrashparams, objDictionary)
  763.       objDictionary.RemoveAll
  764.  
  765.       objDictionary.Add "YELLOW", myconfig.TestParam("BTMQHproc", "threadsy")
  766.       objDictionary.Add "RED", myconfig.TestParam("BTMQHproc", "threadsr")
  767.       Call FillmmDict(objProcess, mmDict, "col6", "GetThreadCount", btmqexe , objDictionary)
  768.       objDictionary.RemoveAll
  769.       ' End BTQMHosts table    
  770.     End If
  771.  
  772.     strIFAScheck = strIFAScheck & outputTag("BTQMHosts", "", BuildMultiMessage(mmDict))
  773.     strIFAScheck = strIFAScheck & "</response>" & vbCrLf
  774.     strIFAScheck = strIFAScheck & "</textarea>" & vbCrLf
  775.     strIFAScheck = strIFAScheck & "</form>" & vbCrLf
  776.     strIFAScheck = strIFAScheck & "</div>"
  777.  
  778.     ' Check Alarms and write log
  779.     status = "green"
  780.     If Instr(strIFAScheck, "state=""yellow""") Then status = "yellow"
  781.     If Instr(strIFAScheck, "state=""red""") Then status = "red"
  782.  
  783.     Call CreateBBLog(myconfig.Hostname, status, myconfig.LogPath, myconfig.Checkname, strIFAScheck)
  784.   End Sub
  785.  
  786.   Call Main()
  787.  
  788.   </script>
  789. </job>
Feb 21 '13 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.