'==========================================================================
'
'
' NAME: HANDLE MQ MESSAGES 
'
' AUTHOR: RICO ANDRIOL 
' DATE  : 2/19/2009
'
'
'==========================================================================
'D E C L A R A T I O N S
Option Explicit   
On Error Resume Next 
Err.Clear
Dim MsgTxt
Dim VBLoc
Dim LogTxt
Dim MessagesPresent
Dim MqSes
Dim MqGMO
Dim MqMan
Dim MqINQue
Dim MqInMsg
Dim StrDate 
Dim Fs, Ft

' MQGMO_* (Get Message Options)
Const MQGMO_BROWSE_FIRST = 16
Const MQGMO_BROWSE_NEXT = 32
' MQOO_* (Open Options)
Const MQOO_INPUT_AS_Q_DEF = 1
Const MQOO_INPUT_SHARED = 2
Const MQOO_INPUT_EXCLUSIVE = 4
Const MQOO_BROWSE = 8
Const MQOO_OUTPUT = 16
Const MQOO_INQUIRE = 32
Const MQOO_SET = 64
Const MQOO_BIND_ON_OPEN = 16384
Const MQOO_BIND_NOT_FIXED = 32768
Const MQOO_BIND_AS_Q_DEF = 0
Const MQOO_SAVE_ALL_CONTEXT = 128
Const MQOO_PASS_IDENTITY_CONTEXT = 256
Const MQOO_PASS_ALL_CONTEXT = 512
Const MQOO_SET_IDENTITY_CONTEXT = 1024
Const MQOO_SET_ALL_CONTEXT = 2048
Const MQOO_ALTERNATE_USER_AUTHORITY = 4096
Const MQOO_FAIL_IF_QUIESCING = 8192
Const MQOO_RESOLVE_NAMES = 65536
Const MQOO_RESOLVE_LOCAL_Q = 262144
' MQCC Returncodes
Const MQCC_OK   = 0
Const MQCC_WARNING   = 1
Const MQCC_FAILED   = 2
Const MQCC_UNKNOWN   = -1
Const MQRC_NO_MSG_AVAILABLE = 2033

'Start processing
CreateSession
CreateQMan
CreateQueue
CreateMess
CreateGMO
MessagesPresent = True
MqGMO.Options = MQGMO_BROWSE_FIRST
MsgTxt = BrowseMess()
MqGMO.Options = MQGMO_BROWSE_NEXT
Do While MessagesPresent = True
	MsgTxt = BrowseMess()
Loop

VBLoc = "Main"
If IsEmpty(LogTxt) Then
Else
	Set Fs = CreateObject("Scripting.FileSystemObject")
	StrDate = IsoDate(Now)
	Set Ft = Fs.CreateTextFile("E:\software\VBScript\MqLog" & StrDate & ".txt", True)
	Ft.WriteLine(LogTxt)
	Ft.Close
	Set Ft = Nothing
	Set Fs = Nothing
End If

Set MqInMsg = Nothing
Set MqSes = Nothing

'============================================
'END of SCRIPT
'============================================

Sub CreateSession
	'Create MQ Session Object
	'============================================
	VBLoc = "CreateSession"
	On Error Resume Next 
	Set MqSes = CreateObject("MQAX200.MqSession")
	MqSes.ExceptionThreshold = 2 'Trap all errors
	If Err.Number <> 0 Then
		HandleError
	End If
End Sub

Sub CreateQMan
	'Create MQ Manager Object
	'============================================
	VBLoc = "CreateQMan"
	On Error Resume Next 
	Set MqMan = MqSes.AccessQueueManager("")
	If Err.Number <> 0 Then
		HandleError
	End If
End Sub

Sub CreateQueue
	'Create MQ Queue Objects
	'============================================
	VBLoc = "CreateQueues"
	On Error Resume Next 
	Set MqInQue = MqMan.AccessQueue("INQUEUE", MQOO_BROWSE + MQOO_INQUIRE)
	If Err.Number <> 0 Then
		HandleError
	End If
	
End Sub

Sub CreateMess 
	'Create MQ Message Objects
	'============================================
	VBLoc = "CreateMess"
	On Error Resume Next 
	Set MqInMsg = CreateObject("MQAX200.MQMessage")
	If Err.Number <> 0 Then
		HandleError
	End If
	
End Sub

Sub CreateGMO
	'Create MQ Get Message Options
	'============================================
	VBLoc = "CreateGMO"
	On Error Resume Next 
	Set MqGMO = MqSes.AccessGetMessageOptions()
	If Err.Number <> 0 Then
		HandleError
	End If
	
End Sub

Function GetMess ()
	'Get Message from Inqueue
	'============================================
	VBLoc = "GetMess"
	On Error Resume Next 
	MqSes.ExceptionThreshold = 3 'Don't trap NO_MSG_AVAILABLE error
	MqInQue.Get(MqInMsg)
	MqSes.ExceptionThreshold = 2 'Trap all errors again
	If Err.Number <> 0 Then
		HandleError
	End If
	If MqInQue.CompletionCode <> MQCC_OK Then
		If MqInQue.ReasonCode = MQRC_NO_MSG_AVAILABLE  Then 
			MessagesPresent = False
			Exit Function
		Else
			LogTxt = "MQ.Get Completion " & MqInQue.CompletionCode & " " & MqInQue.ReasonCode
			WScript.Quit
		End If
	End If
	GetMess = MqInMsg.ReadString(MqInMsg.MessageLength)
	LogTxt = "Message read from INQUEUE: " & GetMess
End Function

Function BrowseMess ()
	'Browse Message from Inqueue
	'============================================
	VBLoc = "BrowseMess"
	On Error Resume Next 
	MqSes.ExceptionThreshold = 3 'Don't trap NO_MSG_AVAILABLE error
	MqInQue.Get MqInMsg, MqGMO
	MqSes.ExceptionThreshold = 2 'Trap all errors again
	If Err.Number <> 0 Then
		HandleError
	End If
	If MqInQue.CompletionCode <> MQCC_OK Then
		If MqInQue.ReasonCode = MQRC_NO_MSG_AVAILABLE  Then 
			MessagesPresent = False
			Exit Function
		Else
			LogTxt = "MQ.Get Completion " & MqInQue.CompletionCode & " " & MqInQue.ReasonCode
			WScript.Quit
		End If
	End If
	BrowseMess = MqInMsg.ReadString(MqInMsg.MessageLength)
	LogTxt = "Message read from INQUEUE: " & BrowseMess
End Function

'Handle errors 
'============================================
Sub HandleError 
	Dim ErrMsg 
	Dim StrPos 
	
	LogTxt = "VBScript MQProc"  & vbCrLf 
	LogTxt = LogTxt & "Location: " & VBLoc & vbCrLf
	LogTxt = LogTxt & "An error occurred as follows:"  & vbCrLf 
	If	MqSes.CompletionCode <> MQCC_OK Then 
		ErrMsg = Err.Description 
		StrPos = InStr(ErrMsg, " ") ' * search for first blank 
		If StrPos > 0 Then 
			LogTxt = LogTxt & Left(ErrMsg, StrPos) & vbCrLf '* print offending MQAX object name
		Else
			LogTxt = LogTxt & Error(Err) & vbCrLf '* print complete error object 
		End If 
		LogTxt = LogTxt & vbCrLf
		LogTxt = LogTxt & "WebSphere MQ Completion Code = " & MqSes.CompletionCode & vbCrLf
		LogTxt = LogTxt & "WebSphere MQ Reason Code = " & MqSes.ReasonCode & vbCrLf 
		LogTxt = LogTxt & "(" & MqSes.ReasonName & ")" & vbCrLf
	Else 
		LogTxt = LogTxt & "Visual Basic error: " & Err & vbCrLf
		LogTxt = LogTxt & Error(Err) & vbCrLf
	End If 
	WScript.Quit
End Sub

Function IsoDate(ByVal MyDate)
	Dim y, m, d, h, n, s
	y = Year(MyDate)
	m = Month(MyDate)
	d = Day(MyDate)
	h = Hour(MyDate)
	n = Minute(MyDate)
	s = Second(MyDate)
	If m < 10 Then m = "0" & m
	If d < 10 Then d = "0" & d
	If h < 10 Then h = "0" & h
	If n < 10 Then n = "0" & n
	If s < 10 Then s = "0" & s
	IsoDate = y & m & d & "_" & h & n & s
End Function