ViewState Serializer, Compressor & Encrypter

'                       Serialization   Deserialization Compression Amount of Data to use   Security    Indicated to:
'ViewState normal:      Good            Bad (binary)    None        Use low Data            *Ninguna    Forms with low controls, Grids with paging
'Serializer normal:     Good            Bad (binary)    Good        Mid proposes            Moderate    Grids with Viewstate turned On Without paging
'Serializer optimized:  Regular         Regular         Regular     Grand Data (DataTable)  Moderade    ViewState with DataTables & Grids with paging or without the Viewstate turned off

Imports System.IO
Imports System.Security.Cryptography
Imports System.Runtime.Serialization

Public Class ViewStateSerializer '2007 ModMa Technoligies
    Inherits System.Web.UI.Page

    Const SessionKey As String = "SerialCryptKey"
    Dim encriptar As Boolean = False
    Dim optimizar As Boolean = False
    Dim pagina As System.Web.UI.Page
    Dim pHash As String = getPageHash()

#Region "Class Inits"

    Sub New()
        initFN(Nothing, Nothing)
    End Sub

    Sub New(ByVal EnCrypt As Boolean, Optional ByVal Optimize As Boolean = False)
        SetViewStateValues(EnCrypt, Optimize)
        initFN(Nothing, Nothing)
    End Sub

    Private Sub initFN(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Init
        Try
            pagina = DirectCast(HttpContext.Current.Handler, System.Web.UI.Page)
        Catch
            'the object is not created, ignore it; desinger mode?
        End Try
    End Sub

    Public Sub SetViewStateValues(ByVal EnCrypt As Boolean, Optional ByVal Optimize As Boolean = False)
        If (pagina Is Nothing) OrElse (Not pagina.IsPostBack) Then ' only can set on Get or New :D
            encriptar = EnCrypt
            optimizar = Optimize
        End If
    End Sub

#End Region

#Region "Overrides Page: Compression / ViewState Cryptography"

    Protected Overrides Function LoadPageStateFromPersistenceMedium() As Object
        Dim viewState As String = Request.Form("__VSTATE")
        Return Me.DeSerialize(viewState)
    End Function

    Protected Overrides Sub SavePageStateToPersistenceMedium(ByVal viewState As Object)
        RegisterHiddenField("__VSTATE", Me.Serialize(viewState))
    End Sub

#End Region

#Region "Functions to Init thea Serialization / Deserialization"

    Public Function Serialize(ByVal viewState As Object) As String
        If viewState Is Nothing Then
            Throw New ArgumentNullException("viewState is Nothing", "Serialize params Error")
        End If

        'Saves the Current Page Configuration
        Dim cfg As Hashtable = getCryptCfg()
        cfg("optSlzEncrypt_" & pHash) = encriptar
        cfg("optSlzOptimize_" & pHash) = optimizar

        Dim bytes As Byte()
        If optimizar Then 'optimize for data option
            Dim formatter As New Formatters.Binary.BinaryFormatter
            Dim writer As New MemoryStream
            Dim transform As Object = cc(viewState)
            formatter.Serialize(writer, transform)
            writer.Position = 0
            bytes = writer.ToArray
        Else 'classic mode
            Dim formatter As New LosFormatter
            Dim writer As New StringWriter
            formatter.Serialize(writer, viewState)
            bytes = Convert.FromBase64String(writer.ToString)
        End If

        Const errorCompression As String = "ViewState Compression Error"
        Try
            bytes = GZipCompress(bytes) 'proceso compresion
        Catch ex As MissingMethodException
            Throw New MissingMethodException(errorCompression & ", have compresion Methods? " & ex.Message, ex)
        Catch ex As MissingMemberException
            Throw New MissingMemberException(errorCompression & ", have compresion Members? " & ex.Message, ex)
        Catch ex As MemberAccessException
            Throw New MemberAccessException(errorCompression & ", have access to compression Methods? :" & ex.Message, ex)
        Catch ex As Exception
            Throw New Exception(errorCompression & ": " & ex.Message, ex)
        End Try

        If encriptar Then
            bytes = Cryptos(bytes, Me.GetKeys(), CryptosMode.EnCrypt)
        End If
        Return Convert.ToBase64String(bytes)
    End Function

    Public Function DeSerialize(ByVal viewState As String) As Object
        If viewState Is Nothing OrElse viewState.Equals(String.Empty) Then
            Throw New ArgumentNullException("viewState is Nothing or Empty", _
                "DeSerialize params Error")
        End If

        'Loads the Current Page Configuration
        Dim cfg As Hashtable = getCryptCfg()
        If Not cfg("optSlzEncrypt_" & pHash) Is Nothing Then
            encriptar = cfg("optSlzEncrypt_" & pHash)
        End If
        If Not cfg("optSlzOptimize_" & pHash) Is Nothing Then
            optimizar = cfg("optSlzOptimize_" & pHash)
        End If

        Dim bytes As Byte() = Convert.FromBase64String(viewState)
        If encriptar Then
            bytes = Cryptos(bytes, Me.GetKeys(), CryptosMode.DeCrypt)
        End If

        Try
            bytes = GZipDecompress(bytes)
        Catch ex As Exception
            Throw New Exception("ViewState Data Error: " & ex.Message, ex)
        End Try

        If optimizar Then 'optimize for data option
            Dim formatter As New Formatters.Binary.BinaryFormatter
            Dim writer As New MemoryStream(bytes)
            writer.Position = 0
            Dim transform As Object = formatter.Deserialize(writer)
            Return cc2(transform)
        Else 'classic mode
            Dim formatter As New LosFormatter
            Return formatter.Deserialize(Convert.ToBase64String(bytes))
        End If
    End Function

#End Region

#Region "Functions to manage the compression (uses SharpZipLib)"

    Public Shared Function GZipCompress(ByVal data As Byte()) As Byte()
        Dim output As New MemoryStream
        Dim gzip As New ICSharpCode.SharpZipLib.GZip.GZipOutputStream(output)
        gzip.Write(data, 0, data.Length)
        gzip.Close()
        Return output.ToArray()
    End Function

    Public Shared Function GZipDecompress(ByVal data As Byte()) As Byte()
        Dim input As New MemoryStream(data)
        input.Position = 0
        Dim gzip As New ICSharpCode.SharpZipLib.GZip.GZipInputStream(input)
        Dim output As New MemoryStream
        Dim buff As Byte() = New Byte(4095) {}
        Dim read As Integer = -1

        read = gzip.Read(buff, 0, buff.Length)
        While read > 0
            output.Write(buff, 0, read)
            read = gzip.Read(buff, 0, buff.Length)
        End While
        gzip.Close()
        Return output.ToArray()
    End Function

#End Region

#Region "Functions to manage the Cryptography"

    Public Shared Function Cryptos(ByVal data As Byte(), ByVal keys As Hashtable, ByVal modo As CryptosMode) As Byte()
        If (keys Is Nothing) OrElse (keys("Key") Is Nothing) OrElse _
            (keys("IV") Is Nothing) OrElse (data Is Nothing) Then
            Throw New ArgumentNullException("data or keys is Nothing", _
                "Cryptos params Error")
        End If

        Dim output As New MemoryStream
        Dim des As New DESCryptoServiceProvider
        Dim cs As New CryptoStream(output, _
            IIf(modo = CryptosMode.EnCrypt, _
                des.CreateEncryptor(keys("Key"), keys("IV")), _
                des.CreateDecryptor(keys("Key"), keys("IV"))), _
                CryptoStreamMode.Write)
        cs.Write(data, 0, data.Length)
        cs.FlushFinalBlock()
        cs.Close()
        Return output.ToArray
    End Function

    Public Enum CryptosMode
        DeCrypt = 0
        EnCrypt = 1
    End Enum

    'gets the Cryptography config (all pages get this)
    Public ReadOnly Property GetKeys() As Hashtable
        Get
            Dim Salida As Hashtable = getCryptCfg()
            If Salida.Item("Key") Is Nothing OrElse _
                Salida.Item("IV") Is Nothing Then
                'go to create the keys
                Dim randObj As New RNGCryptoServiceProvider
                Dim IV(7) As Byte : randObj.GetNonZeroBytes(IV)
                Dim key() As Byte = BitConverter.GetBytes(Date.Now.Ticks)
                Salida.Add("Key", key) ' the key
                Salida.Add("IV", IV) ' initial value
            End If
            Return Salida
        End Get
    End Property

    'bad name: aux function to create the session config
    Private Function getCryptCfg() As Hashtable
        Dim salida As Hashtable
        With HttpContext.Current.Session
            If (.Item(SessionKey) Is Nothing) OrElse _
                (Not TypeOf .Item(SessionKey) Is Hashtable) Then
                salida = New Hashtable
                .Add(SessionKey, salida)
            Else
                salida = DirectCast(.Item(SessionKey), Hashtable)
            End If
            Return salida
        End With
    End Function

    'returns the page string MD5 hash
    Public Function getPageHash() As String
        Try
            Dim hash As MD5 = MD5.Create()
            Dim encoder As New System.Text.ASCIIEncoding
            Return Convert.ToBase64String(hash.ComputeHash(encoder.GetBytes( _
                HttpContext.Current.Request.FilePath.ToLower)))
        Catch
            'the object is not created, ignore it; desinger mode?
            Return String.Empty
        End Try
    End Function

#End Region

#Region "Functions to prepare the binary serialization, replace of Triplet and Pair"

    Private Function cc(ByVal tipo As Object) As Object
        If tipo Is Nothing Then Return Nothing
        If esConocido(tipo) Then
            Return tipo
        ElseIf TypeOf tipo Is System.Web.UI.Triplet Then
            Return New seriable3( _
                cc(tipo.First), _
                cc(tipo.Second), _
                cc(tipo.Third))
        ElseIf TypeOf tipo Is System.Web.UI.Pair Then
            Return New seriable2( _
                cc(tipo.First), _
                cc(tipo.Second))
        ElseIf TypeOf tipo Is ArrayList Then
            Dim trans As ArrayList = DirectCast(tipo, ArrayList)
            Dim salida As New ArrayList(trans.Count)
            For Each x As Object In trans
                salida.Add(cc(x))
            Next
            Return salida
        ElseIf IsArray(tipo) Then
            Dim trans As Array = DirectCast(tipo, Array)
            Dim cuenta As Integer = trans.Length - 1
            Dim salida As Array = Array.CreateInstance(tipo.GetType().GetElementType, trans.Length)
            For x As Integer = 0 To cuenta
                salida(x) = cc(trans(x))
            Next
            Return salida
        ElseIf TypeOf tipo Is Hashtable Then
            Dim enumerator As IDictionaryEnumerator = DirectCast(tipo, Hashtable).GetEnumerator
            Dim salida As New Hashtable
            Do While enumerator.MoveNext
                salida.Add(cc(enumerator.Key), cc(enumerator.Value))
            Loop
            Return salida
        Else
            Dim valueType As Type = tipo.GetType()
            Dim destinationType As Type = GetType(String)
            Dim flag As Boolean
            Dim flag2 As Boolean
            Dim converter As System.ComponentModel.TypeConverter = System.ComponentModel.TypeDescriptor.GetConverter(valueType)
            If ((converter Is Nothing) OrElse TypeOf converter Is System.ComponentModel.ReferenceConverter) Then
                flag = False
                flag2 = False
            Else
                flag = converter.CanConvertTo(destinationType)
                flag2 = converter.CanConvertFrom(destinationType)
            End If
            If (flag AndAlso flag2) Then
                Return New generalCnv(valueType, _
                    converter.ConvertToInvariantString(tipo))
            Else
                Return tipo 'Salida General
            End If
        End If
    End Function

    Private Function cc2(ByVal tipo As Object) As Object
        If tipo Is Nothing Then Return Nothing
        If TypeOf tipo Is seriable3 Then
            Dim trans As seriable3 = DirectCast(tipo, seriable3)
            Return New System.Web.UI.Triplet( _
                cc2(trans.First), _
                cc2(trans.Second), _
                cc2(trans.Third))
        ElseIf TypeOf tipo Is seriable2 Then
            Dim trans As seriable2 = DirectCast(tipo, seriable2)
            Return New System.Web.UI.Pair( _
                cc2(trans.First), _
                cc2(trans.Second))
        ElseIf TypeOf tipo Is ArrayList Then
            Dim salida As ArrayList = DirectCast(tipo, ArrayList)
            Dim cuenta As Integer = salida.Count - 1
            For x As Integer = 0 To cuenta
                salida(x) = cc2(salida(x))
            Next
            Return salida
        ElseIf IsArray(tipo) Then
            Dim salida As Array = DirectCast(tipo, Array)
            Dim cuenta As Integer = salida.Length - 1
            For x As Integer = 0 To cuenta
                salida(x) = cc2(salida(x))
            Next
            Return salida
        ElseIf TypeOf tipo Is Hashtable Then
            Dim enumerator As IDictionaryEnumerator = DirectCast(tipo, Hashtable).GetEnumerator
            Dim salida As New Hashtable
            Do While enumerator.MoveNext
                salida.Add(cc2(enumerator.Key), cc2(enumerator.Value))
            Loop
            Return salida
        ElseIf TypeOf tipo Is generalCnv Then
            Dim datos As generalCnv = DirectCast(tipo, generalCnv)
            Dim converter As System.ComponentModel.TypeConverter = System.ComponentModel.TypeDescriptor.GetConverter(datos.bTipo)
            Return converter.ConvertFromInvariantString(datos.bString)
        Else
            Return tipo 'Salida General
        End If
    End Function

    Private Function esConocido(ByVal elemento As Object) As Boolean
        If (elemento.GetType().IsSealed) And _
        (Not TypeOf elemento Is ArrayList) And _
        (Not IsArray(elemento)) And _
        (Not TypeOf elemento Is Hashtable) Then
            Return elemento.GetType().IsSerializable
        End If
        Return False
    End Function

#End Region

#Region "Aux Objects, replace of Triplet and Pair"

    <Serializable()> Private Class seriable3
        Public First As Object
        Public Second As Object
        Public Third As Object

        Sub New()
        End Sub
        Sub New(ByVal i_First As Object, ByVal i_Second As Object, ByVal i_Third As Object)
            First = i_First : Second = i_Second : Third = i_Third
        End Sub
    End Class

    <Serializable()> Private Class seriable2
        Public First As Object
        Public Second As Object

        Sub New()
        End Sub
        Sub New(ByVal i_First As Object, ByVal i_Second As Object)
            First = i_First : Second = i_Second
        End Sub
    End Class

    <Serializable()> Private Class generalCnv
        Public bTipo As System.Type
        Public bString As String

        Sub New()
        End Sub
        Sub New(ByVal i_bTipo As System.Type, ByVal i_bString As String)
            bTipo = i_bTipo : bString = i_bString
        End Sub
    End Class

#End Region

End Class