异类HOW TO:适时弹出指示框(三)

Author:水如烟

基础类:
MethodWatcherBaseAttribute.vb

Imports System.Runtime.Remoting.Contexts
Imports System.Runtime.Remoting.Activation

Namespace uRemoting.MethodWatcher

    <AttributeUsage(AttributeTargets.Class)> _
    Public MustInherit Class MethodWatcherBaseAttribute
        Inherits ContextAttribute

        Sub New()
            MyBase.New("MethodWatcherBase")
        End Sub

        Public Overrides Sub GetPropertiesForNewContext(ByVal ctorMsg As System.Runtime.Remoting.Activation.IConstructionCallMessage)
            MethodCollection.GetAppendMethodsFromType(ctorMsg.ActivationType) '从ctorMsg中取类要绑定的方法信息
            ctorMsg.ContextProperties.Add(GetMethodWatcherProperty)
        End Sub

        Protected MustOverride Function GetMethodWatcherProperty() As MethodWatcherBaseProperty

    End Class

End Namespace

MethodWatcherBaseProperty.vb

Imports System.Runtime.Remoting.Activation
Imports System.Runtime.Remoting.Contexts
Imports System.Runtime.Remoting.Messaging

Namespace uRemoting.MethodWatcher

    Public MustInherit Class MethodWatcherBaseProperty
        Implements IContextProperty, IContributeObjectSink

        Protected MustOverride Function CreateSink(ByVal nextSink As IMessageSink) As IMessageSink

        Protected Overridable Function GetName() As String
            Return Me.GetType.Name  '"MethodWatcherBase"
        End Function

        Protected Overridable Sub FreezeImpl(ByVal newContext As Context)
            Return
        End Sub

        Protected Overridable Function CheckNewContext(ByVal newCtx As Context) As Boolean
            Return True
        End Function


        Public Sub Freeze(ByVal newContext As System.Runtime.Remoting.Contexts.Context) Implements System.Runtime.Remoting.Contexts.IContextProperty.Freeze
            FreezeImpl(newContext)
        End Sub

        Public Function IsNewContextOK(ByVal newCtx As System.Runtime.Remoting.Contexts.Context) As Boolean Implements System.Runtime.Remoting.Contexts.IContextProperty.IsNewContextOK
            Return CheckNewContext(newCtx)
        End Function

        Public ReadOnly Property Name() As String Implements System.Runtime.Remoting.Contexts.IContextProperty.Name
            Get
                Return GetName()
            End Get
        End Property

        Public Function GetObjectSink(ByVal obj As System.MarshalByRefObject, ByVal nextSink As System.Runtime.Remoting.Messaging.IMessageSink) As System.Runtime.Remoting.Messaging.IMessageSink Implements System.Runtime.Remoting.Contexts.IContributeObjectSink.GetObjectSink
            Return CreateSink(nextSink)
        End Function

    End Class

End Namespace

MethodWatcherBaseSink.vb

Imports System.Collections
Imports System.Runtime.Remoting.Contexts
Imports System.Runtime.Remoting.Messaging
Imports System.Runtime.Remoting.Activation

Namespace uRemoting.MethodWatcher

    Public MustInherit Class MethodWatcherBaseSink
        Implements IMessageSink

        Private m_BeforeHandles As SortedList
        Private m_AfterHandles As SortedList
        Private m_NextSink As IMessageSink

        Sub New(ByVal nextSink As IMessageSink)
            m_NextSink = nextSink
            m_BeforeHandles = New SortedList
            m_AfterHandles = New SortedList
            AddAllBeforeMethodCallHandles()
            AddAllAfterMethodCallHandles()
        End Sub

        Protected Sub AddBeforeMethodCallHandle(ByVal methodName As String, ByVal beforeHandle As BeforeMethodCallHandle)
            SyncLock Me.m_BeforeHandles
                If Not Me.m_BeforeHandles.Contains(methodName) Then
                    m_BeforeHandles.Add(methodName, beforeHandle)
                End If
            End SyncLock
        End Sub

        Protected Sub AddAfterMethodCallHandle(ByVal methodName As String, ByVal afterHandle As AfterMethodCallHandle)
            SyncLock Me.m_AfterHandles
                If Not Me.m_AfterHandles.Contains(methodName) Then
                    m_AfterHandles.Add(methodName, afterHandle)
                End If
            End SyncLock
        End Sub

        Protected Sub AddAllBeforeMethodCallHandles()
            For Each methodName As String In MethodCollection.DefaultInstance.Keys
                If MethodCollection.DefaultInstance(methodName).GetType.Equals(MethodWatcherAppendAttributeType) Then
                    AddBeforeMethodCallHandle(methodName, New BeforeMethodCallHandle(AddressOf Before_MethodCall))
                End If
            Next
        End Sub

        Protected Sub AddAllAfterMethodCallHandles()
            For Each methodName As String In MethodCollection.DefaultInstance.Keys
                If MethodCollection.DefaultInstance(methodName).GetType.Equals(MethodWatcherAppendAttributeType) Then
                    AddAfterMethodCallHandle(methodName, New AfterMethodCallHandle(AddressOf After_MethodCall))
                End If
            Next
        End Sub


        Protected Overridable Sub Before_MethodCall(ByVal callMsg As IMethodCallMessage, ByVal MethodAppendType As System.Type)
            If callMsg Is Nothing Then
                Return
            End If

            MethodWatcherCenter.ReceiveBeforeMethodCallEvent(callMsg, MethodAppendType)
        End Sub

        Protected Overridable Sub After_MethodCall(ByVal replyMsg As IMethodReturnMessage, ByVal MethodAppendType As System.Type)
            If replyMsg Is Nothing Then
                Return
            End If

            MethodWatcherCenter.ReceiveAfterMethodCallEvent(replyMsg, MethodAppendType)
        End Sub

        Protected MustOverride ReadOnly Property MethodWatcherAppendAttributeType() As Type

        Protected Function FindBeforeMethodCallHandle(ByVal methodName As String) As BeforeMethodCallHandle
            Dim beforeHandle As BeforeMethodCallHandle
            SyncLock Me.m_BeforeHandles
                beforeHandle = CType(m_BeforeHandles(methodName), BeforeMethodCallHandle)
            End SyncLock
            Return beforeHandle
        End Function

        Protected Function FindAfterMethodCallHandle(ByVal methodName As String) As AfterMethodCallHandle
            Dim afterHandle As AfterMethodCallHandle
            SyncLock Me.m_AfterHandles
                afterHandle = CType(m_AfterHandles(methodName), AfterMethodCallHandle)
            End SyncLock
            Return afterHandle
        End Function

        Public Function AsyncProcessMessage(ByVal msg As System.Runtime.Remoting.Messaging.IMessage, ByVal replySink As System.Runtime.Remoting.Messaging.IMessageSink) As System.Runtime.Remoting.Messaging.IMessageCtrl Implements System.Runtime.Remoting.Messaging.IMessageSink.AsyncProcessMessage
            Return Nothing
        End Function

        Public ReadOnly Property NextSink() As System.Runtime.Remoting.Messaging.IMessageSink Implements System.Runtime.Remoting.Messaging.IMessageSink.NextSink
            Get
                Return m_NextSink
            End Get
        End Property


        Public Function SyncProcessMessage(ByVal msg As System.Runtime.Remoting.Messaging.IMessage) As System.Runtime.Remoting.Messaging.IMessage Implements System.Runtime.Remoting.Messaging.IMessageSink.SyncProcessMessage
            Dim [call] As IMethodCallMessage = CType(msg, IMethodCallMessage)
            Dim methodName As String = MethodWatcherCommon.GetFullMethodName(msg, MethodWatcherAppendAttributeType) '这里取全名
            Dim beforeHandle As BeforeMethodCallHandle = FindBeforeMethodCallHandle(methodName)

            If beforeHandle IsNot Nothing Then
                beforeHandle([call], MethodWatcherAppendAttributeType)
            End If

            Dim retMsg As System.Runtime.Remoting.Messaging.IMessage = m_NextSink.SyncProcessMessage(msg)
            Dim reply As IMethodReturnMessage = CType(retMsg, IMethodReturnMessage)
            Dim afterHandle As AfterMethodCallHandle = FindAfterMethodCallHandle(methodName)

            If afterHandle IsNot Nothing Then
                afterHandle(reply, MethodWatcherAppendAttributeType)
            End If

            Return retMsg
        End Function
    End Class

End Namespace

MethodWatcherDelegate.vb

Imports System.Runtime.Remoting.Messaging

Namespace uRemoting.MethodWatcher

    Public Delegate Sub BeforeMethodCallHandle(ByVal callMsg As IMethodCallMessage, ByVal MethodAppendType As System.Type)
    Public Delegate Sub AfterMethodCallHandle(ByVal replyMsg As IMethodReturnMessage, ByVal MethodAppendType As System.Type)

End Namespace

MethodWatcherAppendBaseAttribute.vb

Namespace uRemoting.MethodWatcher

    <AttributeUsage(AttributeTargets.Class, allowmultiple:=True)> _
    Public MustInherit Class MethodWatcherAppendBaseAttribute
        Inherits Attribute

        Private gMethodName As String
        Private gWatchContextType As System.Type

        Sub New(ByVal methodName As String)
            gMethodName = methodName
        End Sub

        Public Property MethodName() As String
            Get
                Return gMethodName
            End Get
            Set(ByVal value As String)
                gMethodName = value
            End Set
        End Property

        Public Sub SetContextType(ByVal contextType As System.Type)
            gWatchContextType = contextType
        End Sub

        Public ReadOnly Property FullMethodName() As String
            Get
                Return MethodWatcherCommon.GetFullMethodName(gWatchContextType, MethodName, Me.GetType)
            End Get
        End Property
    End Class


End Namespace

基础实现:
MethodCollection.vb

Namespace uRemoting.MethodWatcher

    Friend Class MethodCollection
        Inherits Dictionary(Of String, MethodWatcherAppendBaseAttribute)

        Private Shared gCollection As MethodCollection
        Shared Sub New()
            gCollection = New MethodCollection
        End Sub
        Private Sub New()
        End Sub

        Public Shared ReadOnly Property DefaultInstance() As MethodCollection
            Get
                Return gCollection
            End Get
        End Property

        Public Shared Sub GetAppendMethodsFromType(ByVal contextType As Type)

            For Each tmpCustomAttribute As Object In contextType.GetCustomAttributes(True)
                If tmpCustomAttribute.GetType.BaseType Is GetType(MethodWatcherAppendBaseAttribute) Then

                    Dim tmpAppendAttribute As MethodWatcherAppendBaseAttribute = CType(tmpCustomAttribute, MethodWatcherAppendBaseAttribute)
                    tmpAppendAttribute.SetContextType(contextType)

                    SyncLock gCollection
                        If Not DefaultInstance.ContainsKey(tmpAppendAttribute.FullMethodName) Then
                            DefaultInstance.Add(tmpAppendAttribute.FullMethodName, tmpAppendAttribute)
                        End If
                    End SyncLock

                End If
            Next
        End Sub

    End Class

End Namespace

MethodWatcherCommon.vb

Namespace uRemoting.MethodWatcher

    Friend Class MethodWatcherCommon
        Private Sub New()
        End Sub

        Public Shared Function GetFullMethodName(ByVal contextType As System.Type, ByVal methodName As String, ByVal MeathodAppendAttibuteType As System.Type) As String
            Return String.Format("{0}+{1}:{2}", contextType.FullName, methodName, MeathodAppendAttibuteType.Name)
        End Function

        Public Shared Function GetFullMethodName(ByVal msg As System.Runtime.Remoting.Messaging.IMessage, ByVal MethodAppendType As System.Type) As String
            Dim tmpType As Type = Type.GetType(msg.Properties("__TypeName").ToString)
            Dim tmpMethodName As String = msg.Properties("__MethodName").ToString
            Return GetFullMethodName(tmpType, tmpMethodName, MethodAppendType)
        End Function

        Public Shared Function GetFullMethodName(ByVal callMsg As System.Runtime.Remoting.Messaging.IMethodCallMessage, ByVal MethodAppendType As System.Type) As String
            Return GetFullMethodName(CType(callMsg, System.Runtime.Remoting.Messaging.IMessage), MethodAppendType)
        End Function

        Public Shared Function GetFullMethodName(ByVal replyMsg As System.Runtime.Remoting.Messaging.IMethodReturnMessage, ByVal MethodAppendType As System.Type) As String
            Return GetFullMethodName(CType(replyMsg, System.Runtime.Remoting.Messaging.IMessage), MethodAppendType)
        End Function

    End Class

End Namespace

MethodWatcherCenter.vb

Imports System.Runtime.Remoting.Messaging

Namespace uRemoting.MethodWatcher

    Public Class MethodWatcherCenter

        Public Shared Event MethodCallBegin As BeforeMethodCallHandle
        Public Shared Event MethodCallOver As AfterMethodCallHandle

        Friend Shared Sub ReceiveBeforeMethodCallEvent(ByVal callMsg As IMethodCallMessage, ByVal MethodAppendType As System.Type)
            RaiseEvent MethodCallBegin(callMsg, MethodAppendType)
        End Sub

        Friend Shared Sub ReceiveAfterMethodCallEvent(ByVal replyMsg As IMethodReturnMessage, ByVal MethodAppendType As System.Type)
            RaiseEvent MethodCallOver(replyMsg, MethodAppendType)
        End Sub

    End Class

End Namespace