异类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