Vbs to query database for MOM 2005
From wiki.perl.lt
Option Explicit
'event type
Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4
Const EVENT_TYPE_AUDITSUCCESS = 8
Const EVENT_TYPE_AUDITFAILURE = 16
' global variables
Dim EventID ' EventId in MOM
Dim EventSource ' EventSource in MOM
Dim oConnStr ' ConnectionString to database
Dim oQueryStr ' Query to execute
Dim Limit ' Number of orders to display
' init script parameters into local variables
oQueryStr = ScriptContext.Parameters.Get("Query")
EventID = CInt(ScriptContext.Parameters.Get("EventID"))
EventSource = ScriptContext.Parameters.Get("Source")
oConnStr = ScriptContext.Parameters.Get("ConnectionString")
Limit = CInt(ScriptContext.Parameters.Get("Limit")) ' limit of result rows to display
Call WriteEventToMOM(GetData())
Function GetData()
dim conn ' sql connection
dim rs ' result recordset
dim result ' result to return from function
dim x ' helper variable
dim i ' helper variable
On Error Resume Next ' enabling manual error handling
set conn = CreateObject("ADODB.Connection")
conn.Open oConnStr
' checking for errors in sql connection
If Err.Number <> 0 Then ' checks for errors on "OPEN CONNECTION"
RaiseError(Err.Description) ' raise alert
Err.Clear ' clear error
rs.Close ' closing dataset
conn.Close ' closing connection
ScriptContext.Quit ' quiting script
End If
' craeting recordset object
set rs = CreateObject("ADODB.recordset")
rs.Open oQueryStr, conn
' checking for errors in query process
If Err.Number <> 0 Then ' check for error on "EXECUTE QUERY"
RaiseError(Err.Description) ' raise alert
Err.Clear ' clear error
rs.Close ' closing dataset
conn.Close ' closing connection
ScriptContext.Quit ' quiting script
End If
' fetching results from recordset
i = 0
result = vbCr
' fetching field names
For Each x In rs.Fields ' fetching field's names
result = result & "|" & cstr(x.Name)
Next
result = result & vbCr
' checking for errors in fields fetch
If Err.Number <> 0 Then ' check for error on "GET FIELD'S NAMES"
RaiseError(Err.Description) ' raise alert
Err.Clear ' clear error
rs.Close ' closing dataset
conn.Close ' closing connection
ScriptContext.Quit ' quiting script
End If
' fetching data
dim tmp
tmp = cstr(i) & " "
do until rs.EOF
If i < Limit Then
For Each x In rs.Fields
result = result & "|" & cstr(x.value)
Next
result = result & vbCr
End If
i = i + 1
rs.MoveNext
loop
' checking for errors in data fetch
If Err.Number <> 0 Then ' check for error on "GET RESULTS"
RaiseError(Err.Description) ' raise alert
Err.Clear ' clear error
rs.Close ' closing dataset
conn.Close ' closing connection
ScriptContext.Quit ' quiting script
End If
' disposing objects
rs.Close
conn.Close
' if more results then limit, displaying message
If i > Limit Then ' if too many orders, printing additional message
result = result + cstr(i - Limit) & " orders not listed"
End If
' checking for error just-in-case
If Err.Number <> 0 Then ' check for MISTERIOUS ERROR
RaiseError(Err.Description) ' raise alert
Err.Clear ' clear error
rs.Close ' closing dataset
conn.Close ' closing connection
ScriptContext.Quit ' quiting script
End If
'disabling manual error handling
On Error GoTo 0
' returning results
GetData = result
End Function
Function RaiseAlert(str)
Dim objEvent
Set objEvent = ScriptContext.CreateEvent
objEvent.EventSource = EventSource
objEvent.EventNumber = EventID
objEvent.EventType = EVENT_TYPE_ERROR
objEvent.SourceDomain = "dom"
objEvent.Message = CStr(str)
ScriptContext.Submit (objEvent)
End Function
Function WriteEventToMOM(EventDescr)
Dim objEvent
Set objEvent = ScriptContext.CreateEvent
objEvent.EventSource = EventSource
objEvent.EventNumber = EventID
objEvent.EventType = EVENT_TYPE_INFORMATION
objEvent.SourceDomain = "dom"
objEvent.Message = CStr(EventDescr)
ScriptContext.Submit (objEvent)
End Function