Pubblicazione File: CTcpManagerSlave
Documento generato mediante: Documentation Creator By BGSoftware


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CTcpManagerSlave"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' *********************************************************************
'* CLASS Slave per Manager utilizzabile per connettere due applicazioni differenti via IP
'* <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">
'*  Il manager delega una istanza di questo oggetto per gestire una connessione specifica _
    verso un peer Manager.
'* </DIV>
' *********************************************************************
Option Explicit

'* Socket usata per coordinarsi con un Manager remoto
Private WithEvents mSocket  As CSocket
Attribute mSocket.VB_VarHelpID = -1
'* Manager unico che funge da Master per questo oggetto
Private mTcpManager         As CTcpManager
Private mstrLastError       As String
'* Indica l'indirizzo dell'host remoto
Private mstrRemoteMsgManagerAddress As String

'* Descrizione dell'ultimo errore
Public Property Get LastError() As String
    LastError = mstrLastError
End Property
'* Descrizione dell'ultimo errore
Private Property Let LastError(newValue As String)
    mstrLastError = newValue
End Property

'* Gestisce l'errore
Private Sub GenerateError(Description As String, Optional Number As Long = vbObjectError)
    LastError = Description
End Sub

'* Gestisce l'errore
Private Sub GenerateErrorGenerico(Procedure As String)
    Call GenerateError("Errore non previsto in " & Procedure & vbCrLf & Err.Description, Err.Number)
End Sub

'* Crea l'oggetto indicando le informazioni necessarie per lavorare
Friend Sub StartListening(s As CSocket, Manager As CTcpManager, RemoteAddress As String)
    Set mSocket = s
    Set mTcpManager = Manager
    mstrRemoteMsgManagerAddress = RemoteAddress
End Sub

'* Tenta di connettersi al pari creando una connessione socket
Friend Function StartConnecting(MsgManager As String, Manager As CTcpManager) As Boolean
On Error GoTo ErrorCatch
Dim tmpSocket   As New CSocket
    Call tmpSocket.RemoteHost.fromString(MsgManager)
    'Riuso la stessa porta locale del server
    tmpSocket.LocalHost.Port = Manager.getPort()
    If Not tmpSocket.OpenClientTCPConnection(False) Then
        Call GenerateError(tmpSocket.LastError, tmpSocket.LastErrorCode)
        Exit Function
    End If
    Debug.Print "Socket state=" & tmpSocket.State
    Set mSocket = tmpSocket
    Set mTcpManager = Manager
    mstrRemoteMsgManagerAddress = MsgManager
    'Ok
    StartConnecting = True
Exit Function
ErrorCatch: Call GenerateErrorGenerico("StartConnecting")
End Function

'* Restituisce la Socket utilizzata per ascoltare
Friend Property Get Socket() As CSocket
    Set Socket = mSocket
End Property

'* Chiude la socket eventualmente aperta e gestita
Friend Sub CloseSocket()
    If Not Socket Is Nothing Then Call Socket.CloseSocket
End Sub

Private Sub Class_Terminate()
    'Pulizia
    Call CloseSocket
    Set mSocket = Nothing
End Sub

Private Sub mSocket_OnDataArrival(ByVal bytesTotal As Long)
Dim tmpBuffer   As String
Dim Env         As New CEnvelope
    
    Call mSocket.GetData(tmpBuffer, vbString)
    'Verifico se il buffer contiene qualcosa di completo
    If Env.fromString(tmpBuffer) Then
        Call mTcpManager.MsgArrivedFromSlave(Env, mstrRemoteMsgManagerAddress)
    End If
End Sub

'* Invia il messaggio Tcp all'host remoto.
'* Per scelta progettuale si aggiunge un ritorno a capo ad ogni messaggio in uscita
Friend Function SendTCPMessage(Env As CEnvelope) As Boolean
On Error GoTo ErrorCatch
    If Socket.SendData(Env.toString() & vbCrLf) Then
        SendTCPMessage = True
    Else
        Call GenerateError("Errore in SendTCPMessage:" & vbCrLf & Socket.LastError)
    End If
Exit Function
ErrorCatch: SendTCPMessage = False
End Function

Private Sub mSocket_OnError(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    Call GenerateError("Socket.OnError " & Number & vbCrLf & Description)
End Sub

Documento generato mediante: Documentation Creator By BGSoftware