Encripta por metodo XOR (utilizado por microsoft access 97,2000 y 2003) visual .net - 30 de Noviembre 2012 - Solo codigos

Bienvenido(a) Visitante | RSS

Mi sitio

Inicio » » Encripta por metodo XOR (utilizado por microsoft access 97,2000 y 2003) visual .net

9:07 PM

Encripta por metodo XOR (utilizado por microsoft access 97,2000 y 2003) visual .net

Function EncriptaXOR(ByVal sTexto As String) As String
        Dim i As Integer
        Dim n As Integer
        Dim tmpValor As String
        Dim y As Integer
        'Expresión1     Expresión2       Resultado es
        'True               True            False
        'True               False           True
        'False              True            True
        'False              False           False

        Dim sValorAsc As Double
        Dim sCaracter As String = ""
        Dim sTxtBibary(9) As Object
        Dim sTxtXOR(9) As Object
        Dim userkeybinary(9) As Object
        Dim userkeyXor(9) As Object
        'Const sCadena = "0,0,0,0,0,0,0,0,0,0,0,0,0,"
        'Const sXOR = "0,1,0,1,1,1,0,1,0,1,0,0,0,0"     ' Mascar de encriptación

        sTxtXOR(1) = "0"
        sTxtXOR(2) = "1"
        sTxtXOR(3) = "0"
        sTxtXOR(4) = "1"
        sTxtXOR(5) = "1"
        sTxtXOR(6) = "1"
        sTxtXOR(7) = "0"
        sTxtXOR(8) = "1"
        sTxtXOR(9) = "0"

        userkeybinary(1) = 1
        userkeybinary(2) = 2
        userkeybinary(3) = 4
        userkeybinary(4) = 8
        userkeybinary(5) = 16
        userkeybinary(6) = 32
        userkeybinary(7) = 64
        userkeybinary(8) = 128
        userkeybinary(9) = 256

        For y = 1 To Len(sTexto)
            For i = 1 To 9
                sTxtBibary(i) = "0"
            Next i

            sValorAsc = Asc(Mid(Trim(sTexto), y, 1))

            For i = 1 To 9
                If userkeybinary(i) >= sValorAsc Then
                    If userkeybinary(i) = sValorAsc Then
                        sTxtBibary(i) = "1"
                    Else
                        sTxtBibary(i - 1) = "1"
                        tmpValor = userkeybinary(i - 1)
                        For n = i - 1 To 1 Step -1
                            If tmpValor + userkeybinary(n) <= sValorAsc Then
                                sTxtBibary(n) = "1"
                                tmpValor = tmpValor + userkeybinary(n)
                            End If
                        Next
                        i = 9
                    End If
                End If
            Next i

            ' Realiza la operación XOR
            'Dim x As Byte
            For i = 1 To 8
                userkeyXor(i) = sTxtBibary(i) Xor sTxtXOR(i)
            Next i

            ' Convierte el nuevo valor binario a codigo ASCCII
            sValorAsc = 0
            For i = 1 To 8
                If userkeyXor(i) = 1 Then sValorAsc = sValorAsc + userkeybinary(i)
            Next i
            sCaracter = sCaracter & Chr(sValorAsc)
            sValorAsc = 0
        Next y

        EncriptaX = sCaracter
    End Function