VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CProcedure"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' *********************************************************************
'* CLASS Oggetto Funzione utile per incapsulare chiamate a procedura remote
'* <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">
'*  Creare la procedura o funzione aggiungendo parametri e impostando il nome.
'*  In fase di costruzione viene automaticamente impostato un InstanceID di default (che si consiglia di non modificare).
'* </DIV>
' *********************************************************************
Option Explicit

'* Nome della procedura remota da chiamare
Private mstrName        As String

'* Identificativo univoco di questa chiamata a procedura
Private mstrInstanceID  As String

'* Parametri in ingresso alla procedura remota
Private mParams         As CVector

'* Carattere delimitatore utilizzato
Private Const CharDelimiter As String = ":"

'* Permette di aggiungere un parametro alla procedura
Public Sub AddParam(newParam As CValue)
    mParams.AddElement newParam
End Sub

'* Permette di recuperare il parametro all'indice indicato della procedura
'* Restituisce Nothing se all'indice non corrisponde alcun parametro
Public Function GetParam(Index As Long) As CValue
    Set GetParam = mParams.Element(Index)
End Function

'* Indica il numero di parametri attualmente memorizzati per la procedura
Public Function GetParamsCount() As Long
    GetParamsCount = mParams.Size
End Function

'* Accesso alla proprietà Name dell'istanza
Public Property Let Name(newValue As String)
    mstrName = newValue
End Property

'* Accesso alla proprietà Name dell'istanza
Public Property Get Name() As String
    Name = mstrName
End Property

'* Accesso alla proprietà InstanceID dell'istanza
Public Property Get InstanceID() As String
    InstanceID = mstrInstanceID
End Property

'* Accesso alla proprietà InstanceID dell'istanza
Friend Property Let InstanceID(newValue As String)
    mstrInstanceID = newValue
End Property

'* Rappresentazione semplice in forma di stringa della procedura
Public Function toString() As String
Dim Result  As String
Dim i       As Long
    Result = Name & "("
    For i = 1 To GetParamsCount
        If i > 1 Then Result = Result & ","
        Result = Result & GetParam(i).getActualValueToString()
    Next i
    Result = Result & ")"
    toString = Result
End Function

'* Rappresentazione della procedura per essere inviata.
'* Il messaggio ha la seguente rappresentazione
'* <InstanceIDLen><Separator><NameLen><Separator><ParamsNumber><Separator> _
    <InstanceID><Name>[<Param1Len>]
Public Function toEnvelope(Sender As ISender, ReceiverObjID As String) As CEnvelope
Dim Message As String
Dim i       As Long
    'Header, Nome e InstanceID
    Message = CStr(Len(InstanceID)) & CharDelimiter & CStr(Len(Name)) & CharDelimiter & _
              CStr(Me.GetParamsCount()) & CharDelimiter & InstanceID & Name
    'Parametri
    For i = 1 To GetParamsCount
        With GetParam(i)
            Message = Message & .getType() & CharDelimiter & _
                                Len(.getActualValueToString()) & CharDelimiter & _
                                .getActualValueToString()
        End With
    Next i
    
    Set toEnvelope = New CEnvelope
    With toEnvelope
        Set .Sender = Sender
        .SetReceiverByObjectID ReceiverObjID
        .Message = Message
    End With
End Function

'* Tenta di ricostruire la procedura dalla sua rappresentazione in forma di stringa _
contenuta nella busta.
'* Restituisce False in caso di errore nella costruzione
Public Function fromEnvelope(Env As CEnvelope) As Boolean
Dim Parti() As String
Dim i       As Long
Dim headerLenght    As Long
Dim numeroParametri As Long
Dim parametri       As String
Dim currentParam    As CValue

    'Header, Nome e InstanceID
    Parti = Split(Env.Message, CharDelimiter)
    If UBound(Parti) < 3 Then Exit Function
    If Not (IsNumeric(Parti(0)) And IsNumeric(Parti(1)) And IsNumeric(Parti(2))) Then Exit Function
    headerLenght = Len(Parti(0)) + Len(Parti(1)) + Len(Parti(2)) + Len(CharDelimiter) * 3
    numeroParametri = CLng(Parti(2))
    
    Me.InstanceID = Mid(Env.Message, headerLenght + 1, CLng(Parti(0)))
    Me.Name = Mid(Env.Message, headerLenght + 1 + CLng(Parti(0)), CLng(Parti(1)))
    parametri = Right(Env.Message, Len(Env.Message) - headerLenght - CLng(Parti(0)) - CLng(Parti(1)))
    
    'Parametri
    For i = 1 To numeroParametri
        Parti = Split(parametri, CharDelimiter, 3)
        If Not IsNumeric(Parti(1)) Then Exit Function
        headerLenght = Len(Parti(0)) + Len(Parti(1)) + Len(CharDelimiter) * 2
        Select Case Parti(0)
            Case "String"
                Set currentParam = New CStringValue
            Case "Int32"
                Set currentParam = New CInt32Value
            Case Else   'Tipo di parametro sconosciuto!!!
                Exit Function
        End Select
        'Setto il valore del parametro
        If Not currentParam.setActualValueFromString(Mid(parametri, headerLenght + 1, CLng(Parti(1)))) Then Exit Function
        'Aggiungo il parametro
        Me.AddParam currentParam
        Set currentParam = Nothing
        parametri = Right(parametri, Len(parametri) - headerLenght - CLng(Parti(1)))
    Next i
    fromEnvelope = True
End Function

'* Restituisce un oggetto CFunctionResult pronto per essere restituito al mittente
'* E' necessario indicare se il risultato è valido e l'eventuale risultato della funzione
Public Function getResponseMessage(IsValid As Boolean, ResultValue As CValue) As CFunctionResult
    Set getResponseMessage = New CFunctionResult
    With getResponseMessage
        .FunctionName = Me.Name
        .InstanceID = Me.InstanceID
        .IsValid = IsValid
        Set .FunctionResult = ResultValue
    End With
End Function

Private Sub Class_Initialize()
    InstanceID = "CProcedure|" & Utilities.getUniqueIdentifier()
    Set mParams = New CVector
End Sub

Private Sub Class_Terminate()
    Set mParams = Nothing
End Sub