MQSeries.net :: View topic

bigdavem · Posted: Sun Nov 17, 2002 4:55 pm Post subject: 2018 on connect

We're getting an intermittent 2018 error on connect using the activex classes on Win 2K. 2018 normally refers to an invalid connection handle, but I didn't think it could occur on a connect since the hConn is just an output parameter. It happens only occasionally and the user can just resubmit their request and it works ok. Any ideas? Code is below (NB this is patched code which attempts to connect 3 times to workaround this error - we'd like to not have to do that).

clsProcessMsg -

Public Function ProcessTransaction(ByVal strSessionID As String, _
ByVal strTransactionSystem As String, _
ByVal strTransactionType As String, _
ByRef varResponse As Variant) As Boolean
'**********************************************************************************
'** Process a given message via MQSeries.
'** The function will return True where processing is completed successfully and
'** False where it fails for any reason.
'** The returned ByRef argument varResponse will contain either:
'** (1) The result string for the successful transaction; or
'** (2) An error message indicating the reason for processing failure.
'** Note: If this Method returns False, the Err object should be checked, as
'** well as the response value.
'**********************************************************************************

On Error GoTo ErrorHandler

Dim objMQSession As clsMQSession
Dim strMQRequestMessage As String
Dim strMQResponseMessage As String
Dim objTxnFmt As Object
Dim strMessage As String
Dim strResponse As String

Set objMQSession = New clsMQSession

mstrTransactionType = strTransactionType

'// Get Parameters for MQSeries from the INI file.
SetMQParameters strTransactionSystem

'// Create the message string for the given transaction type.
Set objTxnFmt = CreateObject("MsgFmts.TxnFmt")
strMessage = objTxnFmt.ConstructTxnString(strSessionID, strTransactionType)
Set objTxnFmt = Nothing

'// Concatenate header records and the transaction message string.
strMQRequestMessage = CreateMQHeaderRecords(strTransactionSystem) & strMessage

'// Process the message via MQSeries.
If SendSynchronousRequestResponse(objMQSession, strMQRequestMessage, strMQResponseMessage) Then
'// Where MQ processing was successful, strip the return message into the
'// component record formats. If the Service Result contains an error code,
'// write it to the log.
If ValidResponseMessage(strMQResponseMessage, strResponse) Then
ProcessTransaction = True
Else
WriteMQErrorLog strResponse
End If
varResponse = strResponse
Else
'// Where MQSeries processing was unsuccessful, write to the error log.
WriteMQErrorLog strMQResponseMessage
varResponse = strMQResponseMessage
End If

Set objMQSession = Nothing

Exit Function

'// Error Handling code.
ErrorHandler:
Err.Raise Err.Number, , _
Err.Description & "; COM:" & App.EXEName & ".dll; Function: clsProcessMsg.ProcessTransaction"

End Function

Private Function SendSynchronousRequestResponse(ByRef objMQSession As clsMQSession, _
ByVal strRequest As String, _
ByRef strResponse As String) As Boolean
'**********************************************************************************
'** A sequence of calls to MQSeries to perform a synchronous send/reply.
'** The function will return True where processing is completed successfully and
'** False where it fails for any reason.
'** The returned ByRef argument strResponse will contain either:
'** (1) The Response (including headers) for the successful transaction; or
'** (2) An error message indicating the reason for processing failure.
'** Logging of MQ messages will be performed during the Put and Get processes.
'**********************************************************************************

Dim intAttempt As Integer 'number of attempts at opening a connection to Queue manger
Const intMax As Integer = 3 'max number of attempts before bailing out

On Error GoTo ErrorHandler

'-----------CONNECT----------------------------------------------------------
'inserted Hamish Bell 14/11/02
'having daily calls to help desk with eKeeper bombing out
'with MQSeries error "2018". This is raised when Connect is unable to get a
'handle from the Queue Manager. Below will attempt connection x times
'with x interval between attempts

objMQSession.Connect mstrQueueManagerName
intAttempt = 1

Do While intAttempt < intMax And objMQSession.CompletionCode <> MQCC_OK
If objMQSession.ReasonCode = 2018 Then
' Suspend program execution for 2 seconds(2000 milliseconds) before attempting to connect again
Sleep 2000
'attempt to connect again
objMQSession.Connect mstrQueueManagerName
intAttempt = intAttempt + 1
'write to log that reconnection attempted
WriteMQLog "HB 14/11/02 TRACE: Connect Attempt Number:" & CStr(intAttempt), mstrRequestQueueName
Else
'if any other error bail out
strResponse = MQError(objMQSession, "MQCONN")
Exit Function
End If
Loop

If objMQSession.CompletionCode <> MQCC_OK And intAttempt >= intMax Then
strResponse = MQError(objMQSession, "MQCONN")
Exit Function
End If

'-----------OPEN REQUEST-----------------------------------------------------
objMQSession.OpenQueue mstrRequestQueueName, True
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQOPEN on Request Queue")
Exit Function
End If

'-----------PUT--------------------------------------------------------------
objMQSession.PutRequest strRequest, mstrResponseQueueName, mstrUserId
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQPUT")
Exit Function
Else
#If cccLogAllMessages Then
WriteMQLog strRequest, mstrRequestQueueName
#End If
End If

'-----------CLOSE REQUEST----------------------------------------------------
objMQSession.CloseQueue
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQCLOSE on Request Queue")
Exit Function
End If

'-----------OPEN RESPONSE----------------------------------------------------
objMQSession.OpenQueue mstrResponseQueueName, False
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQOPEN on Response Queue")
Exit Function
End If

'-----------GET--------------------------------------------------------------
objMQSession.GetResponse
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQGET")
Exit Function
Else
strResponse = objMQSession.Response
#If cccLogAllMessages Then
WriteMQLog strResponse, mstrResponseQueueName
#End If
End If

'-----------CLOSE RESPONSE---------------------------------------------------
objMQSession.CloseQueue
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQCLOSE on Response Queue")
Exit Function
End If

'-----------DISCONNECT-------------------------------------------------------
objMQSession.Disconnect
If objMQSession.CompletionCode <> MQCC_OK Then
strResponse = MQError(objMQSession, "MQDISC")
Exit Function
End If

SendSynchronousRequestResponse = True

Exit Function

'// Error Handling code.
ErrorHandler:
Err.Raise Err.Number, , _
Err.Description & "; COM:" & App.EXEName & ".dll; Function: clsProcessMsg.SendSynchronousRequestResponse"

End Function

Class clsMQSession -

Option Explicit

Const MQ_NEVER_RAISE As Long = 3 'Used to instruct MQAX200.dll to never raise an error.
Const MQ_WAIT_INTERVAL As Long = 40000 'The interval (in ms) that MQSeries will wait for a response.

'// MQ Objects from "MQAX200.dll".
Private mMQSession As Object
Private mMQQueueManager As Object
Private mMQQueue As Object
Private mMQMessage As Object

'// MQ command results.
'// These property values are set by each public method.
Private mlngCompletionCode As Long
Private mlngReasonCode As Long
Private mstrReasonName As String

Private Sub Class_Initialize()

Debug.Print "Instance of clsMQSession created."

End Sub

Private Sub Class_Terminate()

Debug.Print "Instance of clsMQSession terminated."

End Sub

Public Sub Connect(strQMName As String)
'**********************************************************************
'** Connect to the Queue manager.
'**********************************************************************

On Error GoTo ErrorHandler

Set mMQSession = CreateObject("MQAX200.MQSession")
mMQSession.ExceptionThreshold = MQ_NEVER_RAISE
mMQSession.ClearErrorCodes

Set mMQQueueManager = CreateObject("MQAX200.MQQueueManager")
Set mMQQueueManager = mMQSession.AccessQueueManager(strQMName)

mlngCompletionCode = mMQSession.CompletionCode
mlngReasonCode = mMQSession.ReasonCode
mstrReasonName = mMQSession.ReasonName

Exit Sub

'// Error Handling code.
ErrorHandler:
Err.Raise Err.Number, , Err.Description & "; COM:" & App.EXEName & ".dll; Function: Connect"

End Sub

Public Sub OpenQueue(strQueueName As String, varRequest As Variant)
'**********************************************************************
'** Access a Queue on the Queue Manager with an open connection.
'**********************************************************************

On Error GoTo ErrorHandler

Dim lOpenOptions As Long

'// Set the Open Options for the Queue to be accessed.
If CBool(varRequest) Then
lOpenOptions = MQOO_FAIL_IF_QUIESCING + MQOO_OUTPUT
Else
lOpenOptions = MQOO_FAIL_IF_QUIESCING + MQOO_INPUT_SHARED
End If

'// Open the queue.
Set mMQQueue = CreateObject("MQAX200.MQQueue")
Set mMQQueue = mMQQueueManager.AccessQueue(strQueueName, lOpenOptions)

mlngCompletionCode = mMQQueueManager.CompletionCode
mlngReasonCode = mMQQueueManager.ReasonCode
mstrReasonName = mMQQueueManager.ReasonName

Exit Sub

'// Error Handling code.
ErrorHandler:
Err.Raise Err.Number, , Err.Description & "; COM:" & App.EXEName & ".dll; Function: OpenQueue"

End Sub

Public Sub PutRequest(strRequest As String, strResponseQueueName As String, strUserId As String)
'**********************************************************************
'** Put a request message onto an open Queue.
'**********************************************************************

On Error GoTo ErrorHandler

Dim objMQPutMsgOptions As Object

Set objMQPutMsgOptions = CreateObject("MQAX200.MQPutMessageOptions")
objMQPutMsgOptions.ClearErrorCodes
objMQPutMsgOptions.Options = MQPMO_FAIL_IF_QUIESCING + _
MQPMO_NO_SYNCPOINT

Set mMQMessage = CreateObject("MQAX200.MQMessage")
mMQMessage.MessageData = CStr(strRequest)
mMQMessage.UserId = strUserId
mMQMessage.ReplyToQueueName = strResponseQueueName
mMQMessage.Format = MQFMT_STRING
mMQMessage.MessageType = MQMT_REQUEST
mMQMessage.Encoding = MQENC_NATIVE
mMQMessage.CharacterSet = MQCCSI_Q_MGR

mMQQueue.ClearErrorCodes
mMQQueue.Put mMQMessage, objMQPutMsgOptions

mlngCompletionCode = mMQQueue.CompletionCode
mlngReasonCode = mMQQueue.ReasonCode
mstrReasonName = mMQQueue.ReasonName

Exit Sub

'// Error Handling code.
ErrorHandler:
Err.Raise Err.Number, , Err.Description & "; COM:" & App.EXEName & ".dll; Function: PutRequest"

End Sub

Public Sub CloseQueue()
'**********************************************************************
'** Close a Queue.
'**********************************************************************

mMQQueue.CloseOptions = MQCO_NONE
mMQQueue.Close

mlngCompletionCode = mMQQueue.CompletionCode
mlngReasonCode = mMQQueue.ReasonCode
mstrReasonName = mMQQueue.ReasonName

End Sub

Public Sub GetResponse()
'**********************************************************************
'** Get a message from the Open response Queue.
'**********************************************************************

On Error GoTo ErrorHandler

Dim objMQGetMsgOptions As Object
Dim strMsgId As String
Dim strCorrelId As String

Set objMQGetMsgOptions = CreateObject("MQAX200.MQGetMessageOptions")
objMQGetMsgOptions.WaitInterval = MQ_WAIT_INTERVAL
objMQGetMsgOptions.Options = MQGMO_FAIL_IF_QUIESCING + _
MQGMO_NO_SYNCPOINT + _
MQGMO_WAIT

'// Store the message and correlation ids from the PUT message.
strMsgId = mMQMessage.MessageIdHex
'sCorrelId = mMQMessage.CorrelationIdHex

Set mMQMessage = CreateObject("MQAX200.MQMessage")
mMQMessage.ClearErrorCodes
mMQMessage.ClearMessage

'// Only retrieve the message with the relevant message id.
mMQMessage.MessageIdHex = strMsgId
'mMQMessage.CorrelationIdHex = strMsgId
mMQQueue.Get mMQMessage, objMQGetMsgOptions

mlngCompletionCode = mMQQueue.CompletionCode
mlngReasonCode = mMQQueue.ReasonCode
mstrReasonName = mMQQueue.ReasonName

Exit Sub

'// Error Handling code.
ErrorHandler:
Err.Raise Err.Number, , Err.Description & "; COM:" & App.EXEName & ".dll; Function: GetResponse"

End Sub

Public Sub Disconnect()
'**********************************************************************
'** Disconnect from the Queue Manager.
'**********************************************************************

mMQQueueManager.Disconnect

mlngCompletionCode = mMQQueueManager.CompletionCode
mlngReasonCode = mMQQueueManager.ReasonCode
mstrReasonName = mMQQueueManager.ReasonName

Set mMQSession = Nothing
Set mMQQueueManager = Nothing
Set mMQQueue = Nothing
Set mMQMessage = Nothing

End Sub

Public Property Get Response() As String
'// The response message for this MQSeries transaction.
If Not mMQMessage Is Nothing Then
Response = mMQMessage.MessageData
End If
End Property

Public Property Get CompletionCode() As Long
CompletionCode = mlngCompletionCode
End Property

Public Property Get ReasonCode() As Long
ReasonCode = mlngReasonCode
End Property

Public Property Get ReasonName() As String
ReasonName = mstrReasonName
End Property