Dim oParams, TargetComputer, TargetDeviceName, bLogSuccessEvent
Dim strName, intPrevTotalTagsRead, intCurrentTotalTagsRead
Dim oReg, oAPI, oBagState
Dim REG_Key, sStateValuePath
Dim strMessage, strErrorDetail
Dim dtStart
Set oParams = WScript.Arguments
if oParams.Count < 4 then
Wscript.Quit -1
End if
Set oAPI = CreateObject("Mom.ScriptAPI")
Set oBagState = oAPI.CreateTypedPropertyBag(StateDataType)
TargetComputer = oParams(0)
TargetDeviceName = oParams(1)
bLogSuccessEvent = CBool(oParams(2))
sStateValuePath = "HKLM\" & oAPI.GetScriptStateKeyPath(oParams(3))
REG_Key = sStateValuePath & "\BizTalk RFID Management Pack\Message Tag Not Seen Log"
GetMonitorStatus
Sub GetMonitorStatus()
Dim strDevXML
Dim objDevs
Dim intDevs, itmDev
Dim strDeviceName, strDeviceIP, strDeviceState, strMonitorStatus
Dim intPrevCntVal, intCurrCntVal
strDevXML = GetDeviceStatus()
Set objDevs = GetXMLObject(strDevXML)
If strDeviceState = "Open" Then
If (intPrevCntVal = 0) and (intCurrCntVal = 0) Then
strMonitorStatus = "1"
strErrorDetail = ""
Else
If intPrevCntVal = intCurrCntVal Then
strMonitorStatus = "0"
strErrorDetail = "Monitor Message Tag Not Seen: For Device Name " & strDeviceName & " with Device IP " & strDeviceIP & " - Total Tags Read: " & CStr(intCurrCntVal)
Else
strMonitorStatus = "1"
strErrorDetail = ""
End If
End If
Else
strMonitorStatus = "1"
strErrorDetail = ""
End If
Next
If bLogSuccessEvent Then
strMessage = "The script '" & SCRIPT_NAME & "' For Device Name '" & strDeviceName & "' - Previous Value: " & CStr(intPrevCntVal) & " - Current Value: " & CStr(intCurrCntVal) & " - Monitor Status ='" & strMonitorStatus & "' Error Detail: " & strErrorDetail
CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
strMessage = "The script '" & SCRIPT_NAME & "' For Device Name '" & strDeviceName & "' completed successfully in " & _
DateDiff("s", dtStart, Now) & " seconds."
CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
End If
oBagState.AddValue "State", strMonitorStatus
oBagState.AddValue "ErrorDetail", strErrorDetail
oAPI.AddItem oBagState
Call oAPI.ReturnItems
End Sub
Sub CreateEvent(lEventID, lEventType, strMessage)
oAPI.LogScriptEvent SCRIPT_NAME,lEventID, lEventType, strMessage
End Sub
Function GetCurrCounterValue()
Dim winmgmt1, intTotalTagsRead
Dim wbemServices, wbemObject, wbemObjectSet
intTotalTagsRead = 0
winmgmt1 = "winmgmts:{impersonationLevel=impersonate}!//" & TargetComputer & ""
Set wbemServices = GetObject(winmgmt1)
Set wbemObjectSet = wbemServices.InstancesOf("Win32_PerfFormattedData_RFIDDevices_RFIDDevices")
For Each wbemObject In wbemObjectSet
strName = wbemObject.Name
intTotalTagsRead = wbemObject.TotalTagsRead
If LCase(strName) = LCase(TargetDeviceName) Then
intCurrentTotalTagsRead = CInt(intTotalTagsRead)
End If
Next
GetCurrCounterValue = intCurrentTotalTagsRead
End Function
Function GetPrevCounterValue(strKey)
On Error Resume Next
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Dim regData
regData = oReg.RegRead(REG_Key & "\" & strKey )
If IsNull(regData) or IsEmpty(regData) or regData = "" Then
GetPrevCounterValue = 0
Else
GetPrevCounterValue = CInt(regData)
End If
Err.Clear
End Function
Function SaveCounterValue(strKey, strValue)
If IsNull(oReg) Then
Set oReg = CreateObject("WScript.Shell")
End If
Call oReg.RegWrite(REG_Key & "\" & strKey , CStr(strValue))
Err.Clear
End Function
Function GetDeviceStatus()
Dim strAllOutPut, intDGCnt
Dim strXMLAns, strXMLDet
Dim ArrDevGrps, itmArrDG
Dim intEmpty
strAllOutPut = ExecuteRFIDCmd(TargetDeviceName, true)
strXMLAns = "<Devices>"
strXMLAns = strXMLAns & GetRegExpText("(Name .*|<host>.*</host>|DeviceConnectionState.*)",strAllOutPut)
strXMLAns = strXMLAns & "</Devices>"
GetDeviceStatus = strXMLAns
End Function
Function ExecuteRFIDCmd(strDeviceNameToUse, boolReadOutput)
Dim ncControlcommand
Dim oShell
Dim curDir
Dim strOptionToUse
Dim strExecOut
strOptionToUse = "GetDeviceStatus"
Set oShell = CreateObject("WScript.Shell")
curDir = oShell.CurrentDirectory
ncControlcommand = "cmd.exe /C """ & QuoteWrap(GetRFIDConsolExePath()) & " " & QuoteWrap(strOptionToUse) & " " & QuoteWrap(strDeviceNameToUse) &""""
IF boolReadOutput Then
strExecOut = RunCmd(ncControlcommand,true)
Else
strExecOut = RunCmd(ncControlcommand,false)
End If
ExecuteRFIDCmd = strExecOut
End Function
Function RunCmd(CmdString, boolGetOutPut)
Dim wshshell
Dim oExec
Dim output
Dim strOutPut
Set wshshell = CreateObject("WScript.Shell")
Set oExec = wshshell.Exec(CmdString)
Set output = oExec.StdOut
Do While oExec.Status = 0
WScript.Sleep 100
if output.AtEndOfStream = false then
IF boolGetOutPut Then
strOutPut = strOutPut & output.ReadAll
End IF
else
exit Do
end if
Loop
IF boolGetOutPut Then
strOutPut = strOutPut & oExec.Stderr.ReadAll
Else
strOutPut = "1"
End IF
If oExec.ExitCode <> 0 Then
strOutPut = "0"
End If
Set wshshell = Nothing
RunCmd = strOutPut
End Function
Function GetRFIDConsolExePath()
Dim nsCtrExeName
nsCtrExeName="rfidclientconsole.exe"
GetRFIDConsolExePath = nsCtrExeName
end Function
Function QuoteWrap(myString)
If (myString <> "") And (left(mySTring,1) <> Chr(34)) And (Right(myString,1) <> Chr(34)) Then
QuoteWrap = Chr(34) & myString & Chr(34)
Else
QuoteWrap = myString
End If
End Function
Function GetRegExpText(strMatchPattern, strSearchText)
Dim objRegEx, Match, Matches, StrReturnStr
Dim intCol : intCol = 1
Dim strHost
Set objRegEx = New RegExp
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.Pattern = strMatchPattern
Set Matches = objRegEx.Execute(strSearchText)
For Each Match in Matches
Select Case intCol
Case 1
strReturnStr = strReturnStr & "<Device>"
strReturnStr = strReturnStr & "<Name>" & Replace(Match.value,"Name ","") & "</Name>"
intCol = intCol +1
Case 2
strHost = Replace(Match.value,"<host>","")
strHost = Replace(strHost,"</host>","")
strReturnStr = strReturnStr & "<IP>" & strHost & "</IP>"
intCol = intCol +1
Case 3
strReturnStr = strReturnStr & "<State>" & Replace(Match.value,"DeviceConnectionState ","") & "</State>"
strReturnStr = strReturnStr & "</Device>"
intCol = 1
End Select
Next
GetRegExpText = strReturnStr
End Function
Function GetXMLObject(strXMLToUse)
Dim objXMLToUse
Set objXMLToUse = CreateObject("MSXML2.domdocument")
objXMLToUse.async = false
objXMLToUse.loadXML(strXMLToUse)
Set GetXMLObject = objXMLToUse
End Function
Function MomCreateObject(ByVal sProgramId)
Dim ObjError
Set ObjError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
ObjError.Save
On Error Goto 0
If ObjError.Number <> 0 Then WScript.Quit
End Function
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
Home
Show References: