Encripcion para visual .net - 30 de Noviembre 2012 - Solo codigos

Bienvenido(a) Visitante | RSS

Mi sitio

Inicio » 2012 » Noviembre » 30 » Encripcion para visual .net

9:10 PM

Encripcion para visual .net

    '---------------------------------------------------------------------
    ' EncryptString
    ' Optimizing by Harvey T.
    ' Corregido por Miguel A. Vallejo Duran
    '---------------------------------------------------------------------
    Public Const ENCRYPT As Integer = 1, DECRYPT As Integer = 2

    Function EncryptString(ByVal Text As String, ByVal Action As Single, ByVal UserPassword As String) As String
        Dim UserKey As String
        Dim Temp As Integer
        'Dim Times As Integer
        Dim i As Integer
        Dim j As Integer
        Dim n As Integer
        Dim rtn As String = ""
        Dim sn As Object

        If Len(UserPassword) < 7 Then
            EncryptString = ""
            'MsgBox("La longitud del password debe ser minimo de 8 caracteres")
            Exit Function
        End If
        '--> Mascara para encriptación a nivel caracter
        UserKey = "BgA‘úí7fGqzË³‡,„-–´´ï·¹^co}¼kì]ö6mâW§ëãç3ne±Ñ©_UÚ†QˆÛÌÇRù£2—x)÷ß¶ÉFœ²0Ï@Õ/4Z!Íu>µ&Sa{P–è3|ZÝh-´Óõw»¢ "

        '//Get UserKey characters
        n = Len(UserKey)
        sn = 1
        Dim UserKeyASCIIS(n) As Object
        '--> Carga la cadena de caracteres Random
        '--> a dicha cadena conbina los caracteres con los del passwod dando una nueva cadena Mascara con el password
        For i = 1 To n
            If sn <= Len(UserPassword) Then
                If Asc(Mid$(UserKey, i, 1)) + Asc(Mid$(UserPassword, sn, 1)) > 255 Then
                    UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))
                Else
                    UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1)) + Asc(Mid$(UserPassword, sn, 1))
                End If
                sn = sn + 1
            Else
                sn = 1
                If Asc(Mid$(UserKey, i, 1)) + Asc(Mid$(UserPassword, sn, 1)) > 255 Then
                    UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))
                Else
                    UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1)) + Asc(Mid$(UserPassword, sn, 1))
                End If
            End If
        Next

        '//Get Text characters
        Dim TextASCIIS(Len(Text)) As Integer
        '--> Carga la cadena de Caracteres a procesar
        For i = 1 To Len(Text)
            TextASCIIS(i) = Asc(Mid$(Text, i, 1))
        Next
        '//Encryption/Decryption
        If Action = ENCRYPT Then
            For i = 1 To Len(Text)
                j = IIf(j + 1 >= n, 1, j + 1)
                Temp = TextASCIIS(i) + UserKeyASCIIS(j)
                If Temp > 254 Then
                    Temp = ((Temp - 254) + 1)
                End If
                '-----------------------------
                If Temp > 254 Then
                    Temp = ((Temp - 254) + 1)
                End If
                '-----------------------------
                rtn = rtn + Chr(Temp)
            Next
        ElseIf Action = DECRYPT Then
            For i = 1 To Len(Text)
                j = IIf(j + 1 >= n, 1, j + 1)
                Temp = TextASCIIS(i) - UserKeyASCIIS(j)
                If Temp < 2 Then
                    Temp = ((Temp + 254) - 1)
                End If
                rtn = rtn + Chr(Temp)
            Next
        End If
        '//Return

        EncryptString = rtn
    End Function