VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsTestProcedures_Stub"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' *********************************************************************
'* CLASS Stub statico per il test per il middleware.
'* <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">
'*  Stub statico per il test per il middleware.
'* </DIV>
' *********************************************************************
Option Explicit
Implements ISender
Implements IReceiver
Implements ClsTestProcedures

'* Dispatcher al quale inviare le richieste
Public Dispatcher           As IDispatcher
Public MsgManagerAddress    As String

Private Risultati           As Collection

Private Sub Class_Initialize()
    Set Risultati = New Collection
End Sub

'* Verifica se è arrivato il risultato della richiesta
'* In tal caso lo restituisce e lo rimuove dalla collezione dei risultati arrivati
Private Function IsResultArrived(InstanceID As String) As CFunctionResult
On Error GoTo ErrorCatch
Dim Risultato   As CFunctionResult
    Set Risultato = Risultati.Item(InstanceID)
    Call Risultati.Remove(InstanceID)
    Set IsResultArrived = Risultato
ErrorCatch:
End Function

'* Indica che è arrivato il risultato della richiesta
Private Sub ResultArrived(Result As CFunctionResult)
    Call Risultati.Add(Result, Result.InstanceID)
End Sub

Private Function ClsTestProcedures_BigConcatena(a As String, b As String, c As String, d As String, e As String, f As String, g As String, h As String, i As String, l As String, m As String, n As String) As Variant
Dim newCProcedure   As New CProcedure
Dim newParamAddendo1    As SMom.CValue
Dim newParamAddendo2    As SMom.CValue
Dim newParamAddendo3    As SMom.CValue
Dim newParamAddendo4    As SMom.CValue
Dim newParamAddendo5    As SMom.CValue
Dim newParamAddendo6    As SMom.CValue
Dim newParamAddendo7    As SMom.CValue
Dim newParamAddendo8    As SMom.CValue
Dim newParamAddendo9    As SMom.CValue
Dim newParamAddendo10    As SMom.CValue
Dim newParamAddendo11    As SMom.CValue
Dim newParamAddendo12    As SMom.CValue
Dim IntialTimer          As Long

    Set newParamAddendo1 = SMom.CreateCValue(a)
    Set newParamAddendo2 = SMom.CreateCValue(b)
    Set newParamAddendo3 = SMom.CreateCValue(c)
    Set newParamAddendo4 = SMom.CreateCValue(d)
    Set newParamAddendo5 = SMom.CreateCValue(e)
    Set newParamAddendo6 = SMom.CreateCValue(f)
    Set newParamAddendo7 = SMom.CreateCValue(g)
    Set newParamAddendo8 = SMom.CreateCValue(h)
    Set newParamAddendo9 = SMom.CreateCValue(i)
    Set newParamAddendo10 = SMom.CreateCValue(l)
    Set newParamAddendo11 = SMom.CreateCValue(m)
    Set newParamAddendo12 = SMom.CreateCValue(n)
    With newCProcedure
        .Name = "BigConcatena"
        .AddParam newParamAddendo1
        .AddParam newParamAddendo2
        .AddParam newParamAddendo3
        .AddParam newParamAddendo4
        .AddParam newParamAddendo5
        .AddParam newParamAddendo6
        .AddParam newParamAddendo7
        .AddParam newParamAddendo8
        .AddParam newParamAddendo9
        .AddParam newParamAddendo10
        .AddParam newParamAddendo11
        .AddParam newParamAddendo12
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
    
    'Ora devo attendere il risultato. In Vb non riesco a fare altro che attendere con un ciclo
    Dim Risultato   As CFunctionResult
    IntialTimer = Timer
    Do While (Risultato Is Nothing) And ((Timer - IntialTimer) < 30)
        DoEvents
        Set Risultato = IsResultArrived(newCProcedure.InstanceID)
    Loop
    If Risultato Is Nothing Then
        Call SMom.RaiseSMomException(TimeOutExpiredException, "ClsTestProcedure_Stub")
    Else
        If Risultato.IsValid Then
            Dim RisultatoValue  As CStringValue
            Set RisultatoValue = Risultato.FunctionResult
            ClsTestProcedures_BigConcatena = RisultatoValue.getValue()
        ElseIf Not Risultato.FunctionResult Is Nothing Then
            Err.Raise 6000, , "Errore in BigConcatena" & vbCrLf & Risultato.FunctionResult.getActualValueToString()
        Else
            Err.Raise 6000, , "Errore non specificato in BigConcatena"
        End If
    End If
    
End Function

Private Function ClsTestProcedures_ComputeDiff(Sottraendo As Long, Sottraente As Long) As Long
Dim newCProcedure   As New CProcedure
Dim newParamAddendo1    As New CInt32Value
Dim newParamAddendo2    As New CInt32Value
Dim IntialTimer          As Long

    newParamAddendo1.setValue Sottraendo
    newParamAddendo2.setValue Sottraente
    
    With newCProcedure
        .Name = "ComputeDiff"
        .AddParam newParamAddendo1
        .AddParam newParamAddendo2
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
    
    'Ora devo attendere il risultato. In Vb non riesco a fare altro che attendere con un ciclo
    Dim Risultato   As CFunctionResult
    IntialTimer = Timer
    Do While (Risultato Is Nothing) And ((Timer - IntialTimer) < 30)
        DoEvents
        Set Risultato = IsResultArrived(newCProcedure.InstanceID)
    Loop
    If Risultato Is Nothing Then
        Call SMom.RaiseSMomException(TimeOutExpiredException, "ClsTestProcedure_Stub")
    Else
        If Risultato.IsValid Then
            Dim RisultatoValue  As CInt32Value
            Set RisultatoValue = Risultato.FunctionResult
            ClsTestProcedures_ComputeDiff = RisultatoValue.getValue()
        ElseIf Not Risultato.FunctionResult Is Nothing Then
            Err.Raise 6000, , "Errore in GetSum" & vbCrLf & Risultato.FunctionResult.getActualValueToString()
        Else
            Err.Raise 6000, , "Errore non specificato in GetSum"
        End If
    End If
End Function

Private Sub ClsTestProcedures_ComputeSum(Addendo1 As Long, Addendo2 As Long)
Dim newCProcedure   As New CProcedure
Dim newParamAddendo1    As New CInt32Value
Dim newParamAddendo2    As New CInt32Value

    newParamAddendo1.setValue Addendo1
    newParamAddendo2.setValue Addendo2
    
    With newCProcedure
        .Name = "ComputeSum"
        .AddParam newParamAddendo1
        .AddParam newParamAddendo2
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
End Sub

Private Function ClsTestProcedures_Concatena(Str1 As String, Str2 As String, Str3 As String) As String
Dim newCProcedure   As New CProcedure
Dim newParamAddendo1    As SMom.CValue
Dim newParamAddendo2    As SMom.CValue
Dim newParamAddendo3    As SMom.CValue
Dim IntialTimer          As Long

    Set newParamAddendo1 = SMom.CreateCValue(Str1)
    Set newParamAddendo2 = SMom.CreateCValue(Str2)
    Set newParamAddendo3 = SMom.CreateCValue(Str3)
    
    With newCProcedure
        .Name = "Concatena"
        .AddParam newParamAddendo1
        .AddParam newParamAddendo2
        .AddParam newParamAddendo3
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
    
    'Ora devo attendere il risultato. In Vb non riesco a fare altro che attendere con un ciclo
    Dim Risultato   As CFunctionResult
    IntialTimer = Timer
    Do While (Risultato Is Nothing) And ((Timer - IntialTimer) < 30)
        DoEvents
        Set Risultato = IsResultArrived(newCProcedure.InstanceID)
    Loop
    If Risultato Is Nothing Then
        Call SMom.RaiseSMomException(TimeOutExpiredException, "ClsTestProcedure_Stub")
    Else
        If Risultato.IsValid Then
            Dim RisultatoValue  As CStringValue
            Set RisultatoValue = Risultato.FunctionResult
            ClsTestProcedures_Concatena = RisultatoValue.getValue()
        ElseIf Not Risultato.FunctionResult Is Nothing Then
            Err.Raise 6000, , "Errore in Concatena" & vbCrLf & Risultato.FunctionResult.getActualValueToString()
        Else
            Err.Raise 6000, , "Errore non specificato in Concatena"
        End If
    End If
    
End Function

Private Function ClsTestProcedures_Divide(Arg1 As Long, Arg2 As Long) As Long
Dim newCProcedure   As New CProcedure
Dim newParamAddendo1    As New CInt32Value
Dim newParamAddendo2    As New CInt32Value
Dim IntialTimer          As Long


    newParamAddendo1.setValue Arg1
    newParamAddendo2.setValue Arg2
    
    With newCProcedure
        .Name = "Divide"
        .AddParam newParamAddendo1
        .AddParam newParamAddendo2
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
    
    'Ora devo attendere il risultato. In Vb non riesco a fare altro che attendere con un ciclo
    Dim Risultato   As CFunctionResult
    IntialTimer = Timer
    Do While (Risultato Is Nothing) And ((Timer - IntialTimer) < 30)
        DoEvents
        Set Risultato = IsResultArrived(newCProcedure.InstanceID)
    Loop
    If Risultato Is Nothing Then
        Call SMom.RaiseSMomException(TimeOutExpiredException, "ClsTestProcedure_Stub")
    Else
        If Risultato.IsValid Then
            Dim RisultatoValue  As CInt32Value
            Set RisultatoValue = Risultato.FunctionResult
            ClsTestProcedures_Divide = RisultatoValue.getValue()
        ElseIf Not Risultato.FunctionResult Is Nothing Then
            Err.Raise 6000, , "Errore in Divide" & vbCrLf & Risultato.FunctionResult.getActualValueToString()
        Else
            Err.Raise 6000, , "Errore non specificato in Divide"
        End If
    End If
End Function

Private Function ClsTestProcedures_GetSum(Addendo1 As Long, Addendo2 As Long) As Long
Dim newCProcedure   As New CProcedure
Dim newParamAddendo1    As New CInt32Value
Dim newParamAddendo2    As New CInt32Value
Dim IntialTimer          As Long


    newParamAddendo1.setValue Addendo1
    newParamAddendo2.setValue Addendo2
    
    With newCProcedure
        .Name = "GetSum"
        .AddParam newParamAddendo1
        .AddParam newParamAddendo2
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
    
    'Ora devo attendere il risultato. In Vb non riesco a fare altro che attendere con un ciclo
    Dim Risultato   As CFunctionResult
    IntialTimer = Timer
    Do While (Risultato Is Nothing) And ((Timer - IntialTimer) < 30)
        DoEvents
        Set Risultato = IsResultArrived(newCProcedure.InstanceID)
    Loop
    If Risultato Is Nothing Then
        Call SMom.RaiseSMomException(TimeOutExpiredException, "ClsTestProcedure_Stub")
    Else
        If Risultato.IsValid Then
            Dim RisultatoValue  As CInt32Value
            Set RisultatoValue = Risultato.FunctionResult
            ClsTestProcedures_GetSum = RisultatoValue.getValue()
        ElseIf Not Risultato.FunctionResult Is Nothing Then
            Err.Raise 6000, , "Errore in GetSum" & vbCrLf & Risultato.FunctionResult.getActualValueToString()
        Else
            Err.Raise 6000, , "Errore non specificato in GetSum"
        End If
    End If
    
End Function

Private Sub ClsTestProcedures_hello()
Dim newCProcedure   As New CProcedure
    
    With newCProcedure
        .Name = "hello"
    End With
    
    Dispatcher.Send newCProcedure.toEnvelope(Me, "ClsTestProcedures_Sckeleton"), MsgManagerAddress
End Sub

Private Function IReceiver_getObjectID() As String
    IReceiver_getObjectID = "ClsTestProcedures_Stub"
End Function

Private Sub IReceiver_msgArrived(Env As SMom.CEnvelope)
    'Sono arrivati dei risultati
    Dim Risultato   As New CFunctionResult
    If Risultato.fromEnvelope(Env) Then
        Call ResultArrived(Risultato)
    End If
End Sub

Private Function ISender_getObjectID() As String
    ISender_getObjectID = "ClsTestProcedures_Stub"
End Function