Option Strict On

Imports System.Runtime.Remoting

Namespace Mbark.SystemCoordination

    Public Module Support

#Region "  Remoting Events  "

        Public Delegate Sub RemotingEventArrivedHandler(ByVal originatingHost As String, ByVal e As EventArgs)

        Public Interface IBroadcaster
            Sub BroadcastRemotingEvent(ByVal originatingHost As String, ByVal e As EventArgs)
            Event RemotingEventArrived As RemotingEventArrivedHandler
        End Interface

        Public Class RemotingEventWrapper
            Inherits MarshalByRefObject

            Public Event RemotingEventArrivedLocally As RemotingEventArrivedHandler
            Public WithEvents broadcaster As IBroadcaster

            Public Sub New(ByVal b As IBroadcaster)
                broadcaster = b
                AddHandler broadcaster.RemotingEventArrived, AddressOf broadcaster_MessageArrived
            End Sub

            Public Sub broadcaster_MessageArrived(ByVal originatingHost As String, ByVal e As EventArgs)
                RaiseEvent RemotingEventArrivedLocally(originatingHost, e)
            End Sub

            Public Overrides Function InitializeLifetimeService() As Object
                Return Nothing
            End Function

            Public Sub StopListening()
                Try
                    RemoveHandler broadcaster.RemotingEventArrived, AddressOf broadcaster_MessageArrived
                Catch ex As RemotingException
                    ' Swallow this exception
                Catch ex As Net.WebException
                    ' Swallow this exception
                Catch ex As Net.Sockets.SocketException
                    ' Swallow this exception
                End Try
            End Sub

        End Class

        Public Class RemotingEventBroadcaster
            Inherits MarshalByRefObject
            Implements IBroadcaster

            Public Event RemotingEventArrived(ByVal originatingHost As String, ByVal e As EventArgs) _
            Implements IBroadcaster.RemotingEventArrived

            Public Sub BroadcastRemotingEvent(ByVal originatingHost As String, ByVal e As EventArgs) _
            Implements IBroadcaster.BroadcastRemotingEvent
                SafeInvokeEvent(originatingHost, e)
            End Sub

            Private Sub SafeInvokeEvent(ByVal originatingHost As String, ByVal e As EventArgs)
                Dim handler As RemotingEventArrivedHandler
                If Not RemotingEventArrivedEvent Is Nothing Then
                    Dim delegates() As System.Delegate = RemotingEventArrivedEvent.GetInvocationList()
                    For i As Integer = 0 To delegates.Length - 1
                        Try
                            handler = DirectCast(delegates(i), RemotingEventArrivedHandler)
                            If Not handler Is Nothing Then handler(originatingHost, e)
                        Catch ex As Net.WebException
                            SkimOffBadDelegate(delegates, i)
                        Catch ex As Net.Sockets.SocketException
                            SkimOffBadDelegate(delegates, i)
                        End Try
                    Next
                End If

            End Sub

            Private Sub SkimOffBadDelegate(ByVal delegates() As System.Delegate, ByVal i As Integer)
                Dim newDelegate As System.Delegate = System.Delegate.Remove(RemotingEventArrivedEvent, delegates(i))
                RemotingEventArrivedEvent = DirectCast(newDelegate, RemotingEventArrivedHandler)
            End Sub

        End Class

#End Region

#Region "  Configuration & Object Factories "

        Public Sub ConfigureRemoting()
            Try
                RemotingConfiguration.Configure("remoting.config.xml")
            Catch ex As RemotingException
                RemotingConfiguration.Configure("..\remoting.config.xml")
            End Try
        End Sub


        Public Function GetObject(ByVal t As Type) As Object
            InitializeTypeCache()
            Dim clientType As WellKnownClientTypeEntry = DirectCast(mTypeMap(t), WellKnownClientTypeEntry)
            Dim newObject As Object


            Try
                newObject = Activator.GetObject(clientType.ObjectType, clientType.ObjectUrl)
            Catch ex As Exception
                Debugger.Break()
            End Try

            If newObject Is Nothing Then Throw New CouldNotInstantiateRemoteObjectException(t)
            Return newObject
        End Function

        Private mTypeMap As New Hashtable

        Private Sub InitializeTypeCache()
            If mTypeMap.Values.Count = 0 Then
                mTypeMap = New Hashtable
                Dim types() As WellKnownClientTypeEntry
                Try
                    types = RemotingConfiguration.GetRegisteredWellKnownClientTypes()
                Catch ex As Exception
                    Debugger.Break()
                End Try
                For i As Integer = 0 To types.Length - 1
                    If types(i).ObjectType Is Nothing Then
                        Throw New NoSuchWellKnownClientTypeException(types(i).ObjectType)
                    Else
                        mTypeMap(types(i).ObjectType) = types(i)
                    End If

                Next
            End If
        End Sub

#End Region

    End Module

End Namespace
