soapsnoop.vb

来自「wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重」· VB 代码 · 共 193 行

' WebMethod attribute that intercepts and copies SOAP request and response messages
' to the Windows Clipboard
' The code for this class was copied from Books Online's
' "Adding SOAP Trace Support to Client Applications" topic and
' slightly modified for use in a referenced C# class library - SoapSnoop.dll
Imports System
Imports System.IO
Imports System.Web.Services.Protocols
Imports System.Threading
Imports System.Windows.Forms
Imports System.Xml
Public Class info

    Private m_request As String = Nothing

    Private m_requestException As Exception = Nothing

    Private m_response As String = Nothing

    Private m_responseException As Exception = Nothing

    Public Property request() As String
        Get
            Return m_request
        End Get
        Set(ByVal value As String)
            m_request = Value
        End Set
    End Property

    Public Property requestException() As Exception
        Get
            Return m_requestException
        End Get
        Set(ByVal value As Exception)
            m_requestException = Value
        End Set
    End Property

    Public Property response() As String
        Get
            Return m_response
        End Get
        Set(ByVal value As String)
            m_response = Value
        End Set
    End Property

    Public Property responseException() As Exception
        Get
            Return m_responseException
        End Get
        Set(ByVal value As Exception)
            m_responseException = Value
        End Set
    End Property

    Public Sub Init()
        m_request = Nothing
        m_requestException = Nothing
        m_response = Nothing
        m_responseException = Nothing
    End Sub
End Class

Public Class Snoop
    Inherits SoapExtension

    Private m_info As info = Nothing

    Private m_oldStream As Stream = Nothing

    Private m_newStream As Stream = Nothing

    Private Shared m_slot As LocalDataStoreSlot = Thread.AllocateDataSlot

    Public Overloads Overrides Function GetInitializer(ByVal lmi As LogicalMethodInfo, ByVal attr As SoapExtensionAttribute) As Object
        Return getInfo()
    End Function

    Public Overloads Overrides Function GetInitializer(ByVal type As Type) As Object
        Throw New NotImplementedException("snoop.GetInitializer is not implemented.")
    End Function

    Public Overrides Sub Initialize(ByVal initializer As Object)
        m_info = CType(initializer, info)
        m_info.Init()
    End Sub

    Public Overrides Sub ProcessMessage(ByVal message As SoapMessage)
        Dim client As SoapClientMessage = CType(message, SoapClientMessage)
        Select Case (client.Stage)
            Case SoapMessageStage.BeforeSerialize
            Case SoapMessageStage.AfterSerialize
                Try
                    m_newStream.Position = 0
                    Dim reader As StreamReader = New StreamReader(m_newStream)
                    m_info.request = FormatXml(reader.ReadToEnd)
                    m_newStream.Position = 0
                    m_newStream.SetLength(0)
                    Dim writer As StreamWriter = New StreamWriter(m_newStream)
                    writer.Write(m_info.request)
                    writer.Flush()
                    Clipboard.SetDataObject((m_info.request + "" & vbCrLf), True)
                Catch e As Exception
                    m_info.requestException = e
                End Try
                m_newStream.Position = 0
                Copy(m_newStream, m_oldStream)
            Case SoapMessageStage.BeforeDeserialize
                m_newStream.SetLength(0)
                Try
                    Copy(m_oldStream, m_newStream)
                    m_newStream.Position = 0
                    Dim reader As StreamReader = New StreamReader(m_newStream)
                    Dim tempData As String = reader.ReadToEnd
                    m_info.response = FormatXml(tempData)
                    m_newStream.Position = 0
                    m_newStream.SetLength(0)
                    Dim writer As StreamWriter = New StreamWriter(m_newStream)
                    writer.Write(tempData)
                    writer.Flush()
                    Clipboard.SetDataObject((m_info.request + ("" & vbCrLf & vbCrLf _
                                    + (m_info.response + "" & vbCrLf))), True)
                Catch e As Exception
                    m_info.responseException = e
                End Try
                m_newStream.Position = 0
            Case SoapMessageStage.AfterDeserialize
            Case Else
                Throw New Exception("invalid stage")
        End Select
    End Sub

    Public Overrides Function ChainStream(ByVal stream As Stream) As Stream
        m_oldStream = stream
        m_newStream = New MemoryStream
        Return m_newStream
    End Function

    Private Sub Copy(ByVal from As Stream, ByVal [to] As Stream)
        Dim reader As TextReader = New StreamReader(from)
        Dim writer As TextWriter = New StreamWriter([to])
        Dim data As String = reader.ReadToEnd
        writer.Write(data)
        writer.Flush()
    End Sub

    Private Function FormatXml(ByVal xml As String) As String
        Dim inDoc As XmlDocument = New XmlDocument
        inDoc.PreserveWhitespace = False
        inDoc.LoadXml(xml)
        Dim writer As StringWriter = New StringWriter
        Dim xmlWriter As XmlTextWriter = New XmlTextWriter(writer)
        xmlWriter.Formatting = Formatting.Indented
        inDoc.WriteContentTo(xmlWriter)
        xmlWriter.Flush()
        Return writer.ToString
    End Function

    'private Stream m_tempStream = null;
    Public Shared Function getInfo() As info
        Dim res As Object = Thread.GetData(m_slot)
        If (res Is Nothing) Then
            res = New info
            Thread.SetData(m_slot, res)
        End If
        Return CType(res, info)
    End Function
End Class

<AttributeUsage(AttributeTargets.Method)> _
Public Class SnoopAttribute
    Inherits SoapExtensionAttribute

    Private m_priority As Integer = 0

    Public Overrides ReadOnly Property ExtensionType() As Type
        Get
            Return GetType(Snoop)
        End Get
    End Property

    Public Overrides Property Priority() As Integer
        Get
            Return m_priority
        End Get
        Set(ByVal value As Integer)
            m_priority = value
        End Set
    End Property
End Class