encryptionextension.vb

This is a book about vb.you could learn this from this book

' Encryption sample
' rhoward 4/22/01
' 
' This sample encrypts data from an ASP.NET Web Service
' by only encrypting the values with the actual response
' of a method call (rather than all the data in the soap message)
' 
' This technique allows for the message to be secure, but
' the soap to still be valid 


Imports System
Imports System.IO
Imports System.Xml
Imports System.Text
Imports System.Web.Services
Imports System.Web.Services.Protocols
Imports System.Security.Cryptography

Public Class EncryptionExtension
		Inherits SoapExtension
		
	Dim oldStream As Stream
    Dim newStream As Stream
	Dim decryptMode As DecryptMode
	Dim encryptMode As EncryptMode
	Dim target As Target
    
    Private key() As Byte = {&H1, &H23, &H45, &H67, &H89, &HAB, &HCD, &HEF}
    Private IV() As Byte = {&H12, &H34, &H56, &H78, &H90, &HAB, &HCD, &HEF}

    Public Overloads Overrides Function GetInitializer(ByVal methodInfo As LogicalMethodInfo, ByVal attribute As SoapExtensionAttribute) As Object
        Return attribute
    End Function

    Public Overloads Overrides Function GetInitializer(ByVal t As Type)
        Return GetType(EncryptionExtension)
    End Function

    Public Overrides Sub Initialize(ByVal initializer As Object)

        Dim attribute As EncryptionExtensionAttribute = CType(initializer, EncryptionExtensionAttribute)

        ' Find the mode we should be in
        decryptMode = attribute.Decrypt
        encryptMode = attribute.Encrypt
        target = attribute.Target

    End Sub

    Public Overrides Sub ProcessMessage(ByVal message As SoapMessage)

        Select Case message.Stage

            Case SoapMessageStage.BeforeSerialize

            Case SoapMessageStage.AfterSerialize
                Encrypt()

            Case SoapMessageStage.BeforeDeserialize
                Decrypt()

            Case SoapMessageStage.AfterDeserialize

            Case Else
                Throw New Exception("invalid stage")
        End Select

    End Sub


    Public Overrides Function ChainStream(ByVal stream As Stream) As Stream
        oldStream = stream
        Dim newStream As New MemoryStream()
        Return newStream
    End Function

    Private Sub Decrypt()
        Dim decryptedStream As New MemoryStream()

        If ((decryptMode = decryptMode.Request) Or (decryptMode = decryptMode.Response)) Then
            Dim reader As New StreamReader(oldStream)
            Dim writer As New StreamWriter(decryptedStream)
            writer.WriteLine(reader.ReadToEnd())
            writer.Flush()

            decryptedStream = DecryptSoap(decryptedStream)

            Copy(decryptedStream, newStream)
        Else
            Copy(oldStream, newStream)
        End If

        newStream.Position = 0
    End Sub

    Private Sub Encrypt()
        newStream.Position = 0

        If ((encryptMode = encryptMode.Request) Or (encryptMode = encryptMode.Response)) Then
            newStream = EncryptSoap(newStream)
        End If

        Copy(newStream, oldStream)
    End Sub

    Private Function ConvertStringToByteArray(ByVal s As String) As Byte()
        Dim ss() As String = s.Split(" "c)

        Dim b() As Byte = {ss.Length}

        Dim i As Integer
        For i = 0 To b.Length - 1
            b(i) = Byte.Parse(ss(i))
        Next

        Return b

    End Function

    Private Function Decrypt(ByVal stringToDecrypt As String) As Byte()
        Dim des As New DESCryptoServiceProvider()
        Dim inputByteArray() As Byte = ConvertStringToByteArray(stringToDecrypt)

        Dim ms As New MemoryStream()
        Dim cs As New CryptoStream(ms, des.CreateDecryptor(key, IV), CryptoStreamMode.Write)

        cs.Write(inputByteArray, 0, inputByteArray.Length)
        cs.FlushFinalBlock()

        Return ms.ToArray()
    End Function

    Private Function Encrypt(ByVal stringToEncrypt As String) As Byte()
        Dim des As New DESCryptoServiceProvider()

        Dim inputByteArray() As Byte = Encoding.UTF8.GetBytes(stringToEncrypt)

        Dim ms As New MemoryStream()
        Dim cs As New CryptoStream(ms, des.CreateEncryptor(key, IV), CryptoStreamMode.Write)

        cs.Write(inputByteArray, 0, inputByteArray.Length)
        cs.FlushFinalBlock()

        Return ms.ToArray()
    End Function

    Public Function EncryptSoap(ByVal streamToEncrypt As Stream) As MemoryStream
        streamToEncrypt.Position = 0
        Dim reader As New XmlTextReader(streamToEncrypt)
        Dim dom As New XmlDocument()
        dom.Load(reader)

        Dim nsmgr As New XmlNamespaceManager(dom.NameTable)
        nsmgr.AddNamespace("soap", "http://schemas.xmlsoap.org/soap/envelope/")
        Dim node As XmlNode = dom.SelectSingleNode("//soap:Body", nsmgr)
        node = node.FirstChild.FirstChild

        Dim outData() As Byte = Encrypt(node.InnerText)

        Dim s As New StringBuilder()

        Dim i As Integer
        For i = 0 To outData.Length - 1
            If (i = (outData.Length - 1)) Then
                s.Append(outData(i))
            Else
                s.Append(outData(i) + " ")
            End If
        Next

        node.InnerText = s.ToString()

        Dim ms As New MemoryStream()
        dom.Save(ms)
        ms.Position = 0

        Return ms
    End Function

    Public Function DecryptSoap(ByVal streamToDecrypt As Stream) As MemoryStream
        streamToDecrypt.Position = 0
        Dim reader As New XmlTextReader(streamToDecrypt)
        Dim dom As New XmlDocument()
        dom.Load(reader)

        Dim nsmgr As New XmlNamespaceManager(dom.NameTable)
        nsmgr.AddNamespace("soap", "http://schemas.xmlsoap.org/soap/envelope/")
        Dim node As XmlNode = dom.SelectSingleNode("//soap:Body", nsmgr)
        node = node.FirstChild.FirstChild

        Dim outData() As Byte = Decrypt(node.InnerText)

        Dim sTmp As String = Encoding.UTF8.GetString(outData)

        node.InnerText = sTmp

        Dim ms As New MemoryStream()
        ms.Position = 0
        dom.Save(ms)
        ms.Position = 0

        Return ms
    End Function

    Sub Copy(ByVal from As Stream, ByVal toStream As Stream)
        Dim reader As New StreamReader(from)
        Dim writer As New StreamWriter(toStream)
        writer.WriteLine(reader.ReadToEnd())
        writer.Flush()
    End Sub
End Class