Vbs to query database for MOM 2005

From wiki.perl.lt
Jump to: navigation, search
	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
Personal tools
Categories