VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMQObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Private Const lWAIT_INTERVAL As Long = 30000
Private Const sMODULE_NAME = "SalsaMQ"

Private Const sAPP_NAME = "SALSA"
Private Const sSECTION_NAME = "SalsaMQ"

Private Const sLONG_REQUEST_KEY_NAME = "LongRequest"
Private Const sSHORT_REQUEST_KEY_NAME = "ShortRequest"
Private Const sREPLY_KEY_NAME = "Reply"
Private Const sREPLY_TO_KEY_NAME = "ReplyTo"
Private Const sWAIT_INTERVAL_KEY_NAME = "WaitInterval"

Private Const sLONG_REQUEST_DEFAULT = "SALSA.LONG.REQUEST.UNT"
Private Const sSHORT_REQUEST_DEFAULT = "SALSA.SHORT.REQUEST.UNT"
Private Const sREPLY_DEFAULT = "SALSA.REPLY.UNT"
Private Const sREPLY_TO_DEFAULT = "SALSA.REPLY.UNT"
Private Const sWAIT_INTERVAL_DEFAULT As Long = "30000"

Private m_objMQSess As MQSession            '* session object
Private m_objQMgr As MQQueueManager         '* queue manager object
Private m_objRequestQueue As MQQueue        '* request queue object
Private m_objReplyQueue As MQQueue          '* reply queue object
Private m_sShortRequestQueueName As String  '* short request queue name
Private m_sLongRequestQueueName As String   '* long request queue name
Private m_sReplyToQueueName As String       '* reply to queue name
Private m_sReplyQueueName As String         '* reply queue name
Private m_sCorrelationID As String          '* unique message id
Private m_lWaitInterval As Long             '* wait interval
Private m_bLocalFlag As Boolean             '* True if connecting to a local NT queue
Private m_lMessageCount As Long             '* Reply queue message count

'(GC 12/21/1999) These variables will store the error number and description.
Private m_lErrorNum As Long
Private m_sErrorDesc As String

Private m_objHostErrorCollection As clsHostErrorCollection

Private Const iWARNING_LEVEL_ERROR As Integer = 1

Public Property Let p_objMQSess(objMQSess As MQSession)
    Set m_objMQSess = objMQSess
End Property

Public Property Get p_objMQSess() As MQSession
    Set p_objMQSess = m_objMQSess
End Property

Public Property Let p_objQMgr(objQMgr As MQQueueManager)
    Set m_objQMgr = objQMgr
End Property

Public Property Get p_objQMgr() As MQQueueManager
    Set p_objQMgr = m_objQMgr
End Property

Public Property Let p_objRequestQueue(objRequestQueue As MQQueue)
    Set m_objRequestQueue = objRequestQueue
End Property

Public Property Get p_objRequestQueue() As MQQueue
    Set p_objRequestQueue = m_objRequestQueue
End Property

Public Property Let p_objReplyQueue(objReplyQueue As MQQueue)
    Set m_objReplyQueue = objReplyQueue
End Property

Public Property Get p_objReplyQueue() As MQQueue
    Set p_objReplyQueue = m_objReplyQueue
End Property

Public Property Let p_sShortRequestQueueName(sShortRequestQueueName As String)
    m_sShortRequestQueueName = sShortRequestQueueName
End Property

Public Property Get p_sShortRequestQueueName() As String
    p_sShortRequestQueueName = m_sShortRequestQueueName
End Property

Public Property Let p_sLongRequestQueueName(sLongRequestQueueName As String)
    m_sLongRequestQueueName = sLongRequestQueueName
End Property

Public Property Get p_sLongRequestQueueName() As String
    p_sLongRequestQueueName = m_sLongRequestQueueName
End Property

Public Property Let p_sReplyToQueueName(sReplyToQueueName As String)
    m_sReplyToQueueName = sReplyToQueueName
End Property

Public Property Get p_sReplyToQueueName() As String
    p_sReplyToQueueName = m_sReplyToQueueName
End Property

Public Property Let p_sReplyQueueName(sReplyQueueName As String)
    m_sReplyQueueName = sReplyQueueName
End Property

Public Property Get p_sReplyQueueName() As String
    p_sReplyQueueName = m_sReplyQueueName
End Property

Public Property Let p_sCorrelationID(sCorrelationID As String)
    m_sCorrelationID = sCorrelationID
End Property

Public Property Get p_sCorrelationID() As String
    p_sCorrelationID = m_sCorrelationID
End Property

Public Property Let p_lWaitInterval(lWaitInterval As Long)
    m_lWaitInterval = lWaitInterval
End Property

Public Property Get p_lWaitInterval() As Long
    p_lWaitInterval = m_lWaitInterval
End Property
Public Property Let p_bLocalFlag(ByVal bInLocalFlag As Boolean)
    m_bLocalFlag = bInLocalFlag
End Property
Public Property Get p_bLocalFlag() As Boolean
    p_bLocalFlag = m_bLocalFlag
End Property
Public Property Let p_lMessageCount(lMessageCount As Long)
    m_lMessageCount = lMessageCount
End Property
Public Property Get p_lMessageCount() As Long
    p_lMessageCount = m_lMessageCount
End Property
Private Sub Class_Initialize()
Dim sWaitInterval As String
    On Error GoTo Class_Initialize_Err

    '*** Create an MQ session and a queue manager
    p_objMQSess = New MQSession
    Set m_objQMgr = m_objMQSess.AccessQueueManager("")
    
    '*** Get the request and reply queue names from the registry
    p_sShortRequestQueueName = GetSetting(sAPP_NAME, sSECTION_NAME, sSHORT_REQUEST_KEY_NAME, sSHORT_REQUEST_DEFAULT)
    p_sLongRequestQueueName = GetSetting(sAPP_NAME, sSECTION_NAME, sLONG_REQUEST_KEY_NAME, sLONG_REQUEST_DEFAULT)
    p_sReplyQueueName = GetSetting(sAPP_NAME, sSECTION_NAME, sREPLY_KEY_NAME, sREPLY_DEFAULT)
    p_sReplyToQueueName = GetSetting(sAPP_NAME, sSECTION_NAME, sREPLY_TO_KEY_NAME, sREPLY_TO_DEFAULT)
    sWaitInterval = GetSetting(sAPP_NAME, sSECTION_NAME, sWAIT_INTERVAL_KEY_NAME, sWAIT_INTERVAL_DEFAULT)
    
    '*** Initialize the wait interval to unlimited (synch.)
    If Len(Trim(sWaitInterval)) = 0 Then
        sWaitInterval = sWAIT_INTERVAL_DEFAULT
    End If
    p_lWaitInterval = CLng(Val(Trim(sWaitInterval)))
    
    Exit Sub
    
Class_Initialize_Err:
    SB_PassNotificationUp Err, sMODULE_NAME, "Class_Initialize"
    
End Sub

Public Sub SB_OpenQueues(ByVal bInShortRunFlag As Boolean)
                            
On Error GoTo SB_OpenQueues_Err

    'p_sShortRequestQueueName = "SYSTEM.DEFAULT.LOCAL.QUEUE"
    
    '*** Close any open queues
    SB_CloseQueues
    
    '*** Open the request queue
    If bInShortRunFlag Then
        p_objRequestQueue = p_objQMgr.AccessQueue(p_sShortRequestQueueName, O_OPEN.MQOO_OUTPUT)
    Else
        p_objRequestQueue = p_objQMgr.AccessQueue(p_sLongRequestQueueName, O_OPEN.MQOO_OUTPUT)
    End If
    
    '*** Open the reply queue
    p_objReplyQueue = p_objQMgr.AccessQueue(p_sReplyQueueName, O_OPEN.MQOO_INPUT_SHARED)
    
    Exit Sub
    
SB_OpenQueues_Err:
    '(GC 12/21/1999) Save the error number and description.
    p_lErrorNum = Err.Number
    p_sErrorDesc = Err.Description

    p_objHostErrorCollection.SB_SetHostError ENUM_MQ_ERROR, iWARNING_LEVEL_ERROR, "", Err.Description
    
    '(GC 12/21/1999) Restore the error number and description.
    Err.Number = p_lErrorNum
    Err.Description = p_sErrorDesc

    SB_PassNotificationUp Err, sMODULE_NAME, "SB_OpenQueues"
    
End Sub

Public Function FN_PutMessage(ByVal sInMessage As String) As String

    On Error GoTo FN_PutMessage_Err
                          
    Dim objPutMsg As MQMessage                 '* message object for put
    Dim objPutOptions As MQPutMessageOptions   '* get message options

    '*** Create the put message object
    Set objPutMsg = p_objMQSess.AccessMessage()
    objPutMsg.MessageData = sInMessage
    objPutMsg.ReplyToQueueName = p_sReplyToQueueName
    
    '*** Create the put options and send the message
    Set objPutOptions = p_objMQSess.AccessPutMessageOptions()
    objPutOptions.Options = MQPMO_NEW_MSG_ID + MQPMO_NEW_CORREL_ID
    objPutMsg.Format = MQFMT_STRING
    objPutMsg.Expiry = MQWI_UNLIMITED
    objPutMsg.MessageType = MQMT_REQUEST
    p_objRequestQueue.Put objPutMsg, objPutOptions
    
    '*** Save the correlation id for the message just sent
    If p_bLocalFlag Then
        p_sCorrelationID = objPutMsg.CorrelationId
    Else
        p_sCorrelationID = objPutMsg.MessageId
    End If
    
    '*** Return the correlation id
    FN_PutMessage = p_sCorrelationID
    
    Exit Function

FN_PutMessage_Err:
    '(GC 12/21/1999) Save the error number and description.
    p_lErrorNum = Err.Number
    p_sErrorDesc = Err.Description

    p_objHostErrorCollection.SB_SetHostError ENUM_MQ_ERROR, iWARNING_LEVEL_ERROR, "", Err.Description
    
    '(GC 12/21/1999) Restore the error number and description.
    Err.Number = p_lErrorNum
    Err.Description = p_sErrorDesc

    SB_PassNotificationUp Err, sMODULE_NAME, "FN_PutMessage"
      
End Function

Public Function FN_GetMessage(ByVal sInCorrelationId As String) As String
    On Error GoTo FN_GetMessage_Err

    Dim objGetMsg As MQMessage                 '* message object for get
    Dim objGetOptions As MQGetMessageOptions   '* put message options
    
    '(GC 12/7/1999) Set a default return value
    FN_GetMessage = ""
    
    '*** If a CorrelationId was passed then use the passed value
    '***    else use the current CorrelationId property (from last Put)
    Set objGetMsg = p_objMQSess.AccessMessage()
    If sInCorrelationId <> "" Then
        objGetMsg.CorrelationId = sInCorrelationId
    Else
        objGetMsg.CorrelationId = p_sCorrelationID
    End If

    '*** Set the get message options
    Set objGetOptions = p_objMQSess.AccessGetMessageOptions()
    objGetOptions.WaitInterval = p_lWaitInterval
    objGetOptions.Options = MQGMO_WAIT + MQGMO_CONVERT + MQGMO_FAIL_IF_QUIESCING
       
    '*** Get the message
    p_objReplyQueue.Get objGetMsg, objGetOptions
    
    '*** Return the message
    FN_GetMessage = objGetMsg.MessageData
    
    Exit Function

FN_GetMessage_Err:
    '(GC 12/21/1999) Save the error number and description.
    p_lErrorNum = Err.Number
    p_sErrorDesc = Err.Description

    p_objHostErrorCollection.SB_SetHostError ENUM_MQ_ERROR, iWARNING_LEVEL_ERROR, "", Err.Description
    
    '(GC 12/21/1999) Restore the error number and description.
    Err.Number = p_lErrorNum
    Err.Description = p_sErrorDesc

    SB_PassNotificationUp Err, sMODULE_NAME, "FN_GetMessage"
      
End Function
Public Function FN_ClearReplyQueue() As Boolean
    On Error GoTo FN_ClearReplyQueue_Err

    Dim objGetMsg As MQMessage                 '* message object for get
    
    p_lMessageCount = 0
    
MessageLoop:
    '*** Create a message object
    Set objGetMsg = p_objMQSess.AccessMessage()
    
    '*** Get the message
    p_objReplyQueue.Get objGetMsg
    Debug.Print objGetMsg.MessageData
    
    '*** Increment the message count and destroy the message object
    p_lMessageCount = p_lMessageCount + 1
    Set objGetMsg = Nothing
    
    '*** Process the next message (loop until queue is empty - On Error handles exit)
    GoTo MessageLoop
    
CommonExit:
    '*** Return the message
    FN_ClearReplyQueue = True
    Exit Function

FN_ClearReplyQueue_Err:
    If p_objReplyQueue.ReasonCode = 2033 Then
        Resume CommonExit
    End If
    Set objGetMsg = Nothing
    FN_ClearReplyQueue = False
    If p_objReplyQueue.ReasonCode <> 0 Then
        Err.Raise p_objReplyQueue.ReasonCode, p_objReplyQueue.ReasonName
    End If
    SB_PassNotificationUp Err, sMODULE_NAME, "FN_ClearReplyQueue"
      
End Function
Private Sub Class_Terminate()
  
    On Error GoTo Class_Terminate_Err

    '*** Close and destroy all open objects
    SB_CloseQueues
    If Not (p_objQMgr Is Nothing) Then
        p_objQMgr.Disconnect
        p_objQMgr = Nothing
    End If
    If Not (p_objMQSess Is Nothing) Then p_objMQSess = Nothing
    
    Exit Sub

Class_Terminate_Err:
    SB_PassNotificationUp Err, sMODULE_NAME, "Class_Terminate"

End Sub

Public Sub SB_CloseQueues()
    On Error GoTo SB_CloseQueues_Err
    
    If Not (p_objRequestQueue Is Nothing) Then
        If p_objRequestQueue.IsOpen Then p_objRequestQueue.Close
        p_objRequestQueue = Nothing
    End If
    If Not (p_objReplyQueue Is Nothing) Then
        If p_objReplyQueue.IsOpen Then p_objReplyQueue.Close
        p_objReplyQueue = Nothing
    End If
    Exit Sub

SB_CloseQueues_Err:
    '(GC 12/21/1999) Save the error number and description.
    p_lErrorNum = Err.Number
    p_sErrorDesc = Err.Description

    p_objHostErrorCollection.SB_SetHostError ENUM_MQ_ERROR, iWARNING_LEVEL_ERROR, "", Err.Description
    
    '(GC 12/21/1999) Restore the error number and description.
    Err.Number = p_lErrorNum
    Err.Description = p_sErrorDesc
    
    SB_PassNotificationUp Err, sMODULE_NAME, "SB_CloseQueues"
End Sub

Public Property Let p_objHostErrorCollection(ByVal objInHostErrorCollection As clsHostErrorCollection)
    Set m_objHostErrorCollection = objInHostErrorCollection
End Property

Public Property Get p_objHostErrorCollection() As clsHostErrorCollection
    Set p_objHostErrorCollection = m_objHostErrorCollection
End Property

Private Property Let p_lErrorNum(ByVal lInErrorNum As Long)
    m_lErrorNum = lInErrorNum
End Property

Private Property Get p_lErrorNum() As Long
    p_lErrorNum = m_lErrorNum
End Property

Private Property Let p_sErrorDesc(ByVal sInErrorDesc As String)
    m_sErrorDesc = sInErrorDesc
End Property

Private Property Get p_sErrorDesc() As String
    p_sErrorDesc = m_sErrorDesc
End Property