awxb02msg.cls

VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB 源始碼 VB

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

Private Sub Class_Initialize()

If gcolMessages Is Nothing Then
    Set gcolMessages = New Collection
End If

End Sub
Public Sub AddXMessage(ByVal strQueue As String, ByVal strMessage As String)

Dim objMessage As clsA02Msg
Set objMessage = New clsA02Msg
objMessage.strMessage = strMessage
XMessageQueue(strQueue).Add objMessage

End Sub
Public Sub GetXMessages(ByVal strQueue As String, colMessages As Collection)

Dim lngCounter As Long
Dim lngTotal As Long

Dim colNewMessages As Collection
Set colNewMessages = XMessageQueue(strQueue)

lngTotal = colNewMessages.Count
Set colMessages = New Collection
If lngTotal > 0 Then
    ReDim strMessages(1 To lngTotal)
End If
For lngCounter = 1 To lngTotal
    colMessages.Add colNewMessages(1)
    colNewMessages.Remove 1
Next

End Sub
Private Property Get XMessageQueue(strQueue As String) As Collection

On Error Resume Next
Dim colMessages As Collection
Set colMessages = gcolMessages(strQueue)
If colMessages Is Nothing Then
    Set colMessages = New Collection
    gcolMessages.Add colMessages, strQueue
End If
Set XMessageQueue = colMessages

End Property