VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSinchronusAndSequentialDispatcher"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' *********************************************************************
'* CLASS Semplice Dispatcher di messaggi sincrono e sequenziale
'* <BR/>Autore: <B>Giorgio Bernardi</B>
'* E-Mail: <A HREF="mailto:giorgio.bernardi@studio.unibo.it">Giorgio.Bernardi@studio.unibo.it</A>
'* Data  : Settembre 2004
'* <DIV CLASS="ClassDescription">
'*  Dispatcher più semplice possibile. Gestisce le richieste in maniera sincrona e sequenziale.
'* </DIV>
' *********************************************************************
Option Explicit
Implements IDispatcher

'* Variabile contenente il valore della proprietà omonima dell'oggetto
Private mMsgManager     As IMsgManager
'* Variabile contenente il valore della proprietà omonima dell'oggetto
Private mReceivers      As CVector

'* Identificativo dell'oggetto che si occuperà di spedire i messaggi ai destinatari
Public Property Get MsgManager() As IMsgManager
    Set MsgManager = mMsgManager
End Property

'* Identificativo dell'oggetto che si occuperà di spedire i messaggi ai destinatari
Public Property Set MsgManager(msgMngr As IMsgManager)
    Set mMsgManager = msgMngr
End Property

'* Funzione che permette ad un possibile destinatario di messaggi, di registrarsi presso il dispatcher
Public Function Register(Receiver As IReceiver) As Boolean
    Call mReceivers.AddElement(Receiver)
    Register = True
End Function

'* Funzione che permette ad un possibile destinatario di messaggi, precedentemente registratosi, di deregistrarsi presso il dispatcher
Public Function UnRegister(Receiver As IReceiver) As Boolean
    Call mReceivers.RemoveElement(Receiver)
    UnRegister = True
End Function

'* Invia il messaggio ad uno dei riceventi registrati
Private Function msgArrived(Env As CEnvelope) As Boolean
Dim Index       As Long
Dim Receiver    As IReceiver
    msgArrived = False
    'Cerco fra altri managers registrati
    For Index = 1 To mReceivers.Size
        Set Receiver = mReceivers.Element(Index)
        If Receiver.getObjectID() = Env.Receiver.getObjectID() Then
            'Informazioni di tracciabilità
            If Env.TraceRoute Is Nothing Then Set Env.TraceRoute = New CEnvelopeTrace
            Set Env.TraceRoute.LocalDispatcher = Me
            Call Receiver.msgArrived(Env)
            msgArrived = True
            Exit For
        End If
    Next Index
End Function

'* Spedice al manager la richiesta di invio in maniera sequenziale e sincrona.
Public Function Send(Env As CEnvelope, MngAddress As String) As Boolean
    If Not MsgManager Is Nothing Then Send = MsgManager.Send(Env, MngAddress)
End Function

Private Sub Class_Initialize()
    Set mReceivers = New CVector
End Sub

Private Sub Class_Terminate()
    mReceivers.Clear
End Sub

Private Function IDispatcher_msgArrived(Env As CEnvelope) As Boolean
    IDispatcher_msgArrived = msgArrived(Env)
End Function

Private Property Set IDispatcher_MsgManager(RHS As IMsgManager)
    Set MsgManager = RHS
End Property

Private Property Get IDispatcher_MsgManager() As IMsgManager
    Set IDispatcher_MsgManager = MsgManager
End Property

Private Function IDispatcher_Register(Receiver As IReceiver) As Boolean
    IDispatcher_Register = Register(Receiver)
End Function

Private Function IDispatcher_Send(Env As CEnvelope, MngAddress As String) As Boolean
    IDispatcher_Send = Send(Env, MngAddress)
End Function

Private Function IDispatcher_UnRegister(Receiver As IReceiver) As Boolean
    IDispatcher_UnRegister = UnRegister(Receiver)
End Function