DMQVB (dmqvb.bas)

The first of two sample files, copied from the examples provided with Bea Message Q installation...


----------
'
' Global Variables
'
Global PutMsg As DmqMsgT
Global GetMsg As DmqMsgT
Global MyQueue As QAddress

Global DmqAttached As Integer

'
' DmqAttachQ
'
' Attach to the DMQ message bus using a temporary queue
'
'
'
Function DmqAttachQ() As Long
Dim status As Long
Dim attach_mode As Long
Dim q_type As Long
Dim q_name As String * 10
Dim q_name_len As Long
Dim name_space_list(2) As Long
Dim nsl_len As Long
Dim timeout As Long
'
' Set attach parameters
'
attach_mode = PSYM_ATTACH_TEMPORARY
q_type = PSYM_ATTACH_PQ
q_name = ""
q_name_len = 0
nsl_len = 0
timeout = 0

MyQueue.Group = 0
MyQueue.Queue = 0

status = pams_attach_q(attach_mode, MyQueue, q_type, q_name, q_name_len, name_space_list(0), nsl_len, timeout, ByVal 0&, ByVal 0&)

DmqAttachQ = status

End Function


'
' DmqExit
'
' Exit from the DMQ bus
'
Function DmqExit()
DmqExit = pams_exit()
End Function

'
' DmqGetMsg
'
' Receive a DmqMsgT message if one is available
'
'
Function DmqGetMsg(Msg As DmqMsgT, MsgArea As String) As Long
Dim status As Long
Static show_buffer As ShowBuffer
Dim show_bufflen As Long
Dim large_area_len As Long
Dim large_size As Long


show_bufflen = SHOW_BUFFER_LEN
large_area_len = 0

status = pams_get_msg(ByVal MsgArea, Msg.Priority, Msg.SrcTarget, Msg.Class, Msg.Type, Msg.MsgAreaSize, Msg.MsgLen, Msg.SelFilter, Msg.PSB, show_buffer, show_bufflen, large_area_len, large_size, ByVal 0&)

DmqGetMsg = status

End Function

'
' DmqGetMsgW
'
' Receive a DmqMsgT message if one is available
'
'
Function DmqGetMsgW(Msg As DmqMsgT, MsgArea As String) As Long
Dim status As Long
Static show_buffer As ShowBuffer
Dim show_bufflen As Long
Dim large_area_len As Long
Dim large_size As Long

show_bufflen = SHOW_BUFFER_LEN
large_area_len = 0

status = pams_get_msgw(ByVal MsgArea, Msg.Priority, Msg.SrcTarget, Msg.Class, Msg.Type, Msg.MsgAreaSize, Msg.MsgLen, Msg.timeout, Msg.SelFilter, Msg.PSB, show_buffer, show_bufflen, large_area_len, large_size, ByVal 0&)

DmqGetMsgW = status

End Function

'
' DmqPutMsg
'
' Send a DmqMsgT to the target queue
'
'
Function DmqPutMsg(Msg As DmqMsgT, MsgArea As String) As Long
Dim status As Long
Dim large_size As Long

large_size = 0

status = pams_put_msg(ByVal MsgArea, Msg.Priority, Msg.SrcTarget, Msg.Class, Msg.Type, Msg.Delivery, Msg.MsgAreaSize, Msg.timeout, Msg.PSB, Msg.UMA, Msg.RespQ, large_size, ByVal 0&, ByVal 0&)

DmqPutMsg = status

End Function

'
' DmqStatusText
'
' Converts a DmQ status code into a descriptive string
'
Function DmqStatusText(Code As Long) As String
Dim status As Long
Dim severity As Long ' Receives severity code
Dim msg_text As String * 4096 ' Receives message text (original = 256, changed to 512)
Dim buflen As Long ' Size of string for message
Dim retlen As Long ' Length of returned message

buflen = Len(msg_text)
status = pams_status_text(Code, severity, msg_text, buflen, retlen)

If Not status = PAMS__FAILED Then
DmqStatusText = msg_text
Else
DmqStatusText = "DmqStatusText failed!"
End If

End Function
----------