[Módulo] Encriptación - VB9 - Informática - Catálogo de artículos - pleoNeT
Viernes, 24-03-2017, 6:50 PM
Le saludo Fantasma | RSS
Inicio | Catálogo de artículos | Registrarse | Entrada
Pleonet
Formulario de entrada
Menú del sitio

Categorías de la sección
VB9 [4]
Historia [2]
Otros [2]

Búsqueda

Nuestra encuesta
Cómo veis la WeB
1. Está bien aunque le falta algo
2. Perfecta, me encanta.
3. Fatal, pésimo.
4. No esta mal
5. Mal
Total de respuestas: 5

Estadística

Total en línea: 1
Invitados: 1
Usuarios: 0

Inicio » Artículos » Informática » VB9

[Módulo] Encriptación
Los métodos presentados a continuación están sacados de la página que podréis encontrar abajo del artículo, yo lo único que he hecho ha sido agruparlos y modificarlos en algunos casos y añadir una función para encontrar claves fácilmente. Cada función contiene en código el autor de su creación en caso de ser público.

Para añadirlo a un proyecto es muy fácil sólo hay que pinchar en el menú Proyecto y darle en Añadir nuevo elemento... a Modulo. Le podéis poner el nombre que queráis por ejemplo Encriptación. No tenéis porque añadir todas las funciones de encriptación si sólo necesitáis una porque os parece que con una tenéis bastante sólamente copiar su código junto el común y yasta (yo por ejemplo en mi aplicación Visual Quz sólo utilizo uno).

En el principio del módulo es recomendable añadir estas constantes para que podamos utilizarlas sin liarnos en el código.
 Private Const ENCRIPTAR As Integer = 1
Private Const DESENCRIPTAR As Integer =
2

La siguiente función que agregaremos es esta que la he creado yo con un poco de imaginación para obtener claves para posteriormente cifrar nuestros archivos y que se obtiene de la manera más aleatoria posible que se me ha ocurrido.

 Public Function Obtener_Clave() As Integer

Dim
clave As Integer = Now.Millisecond

Do
If clave > 60000 Then
clave /= Math.Sqrt(Now.Millisecond)
ElseIf clave < 15000 Then
clave /= Math.Cos(Now.Millisecond)
End If

If Math.Abs(CInt(clave)) > 100000 Then clave = Now.Millisecond

Loop Until clave > 9999 And clave < 60000

Return clave
End Function
Y acontinuación tenemos cada una de las funciones. Como originalmente su nombre era Encriptación para todas pues yo se lo he cambiado dependiendo de su función. También algunas funciones necesitan de otras para funcionar, ya las incluyo.

Encriptación por un método de encriptación utilizando los númerosos hexadecimales:


 Public Function EncriptarHEX(ByVal DataValue As Object, ByVal Accion As Single) As Object
'..................
'...By Miguel Cejas
'..................

Dim x As Long
Dim Temp As String = ""
Dim TempNum As Integer
Dim TempChar As String
Dim TempChar2 As String
Dim HexByte As String

If
Accion = ENCRYPT Then

For x = 1 To Len(DataValue)
TempChar2 = Mid(DataValue, x, 1)
TempNum = Int(Asc(TempChar2) / 16)

If ((TempNum * 16) < Asc(TempChar2)) Then
TempChar = ConvToHex(Asc(TempChar2) - (TempNum * 16))
Temp = Temp & ConvToHex(TempNum) & TempChar
Else
Temp = Temp & ConvToHex(TempNum) & "0"
End If

Next (x)

ElseIf Accion = DECRYPT Then

For x = 1 To Len(DataValue) Step 2
HexByte = Mid(DataValue, x, 2)
Temp = Temp & Chr(ConvToInt(HexByte))
Next (x)

End If

' retorno
EncriptarHEX = Temp
End Function
    Private Function ConvToHex(ByVal x As Integer) As String
        If x > 9 Then
            ConvToHex = Chr(x + 55)
        Else
            ConvToHex = CStr(x)
        End If
    End Function
    Private Function
ConvToInt(ByVal x As String) As Integer

        Dim x1 As String
        Dim x2 As String
        Dim Temp As Integer

        x1 = Mid(x, 1, 1)
        x2 = Mid(x, 2, 1)

        If IsNumeric(x1) Then
            Temp = 16 * Int(x1)
        Else
            Temp = (Asc(x1) - 55) * 16
        End If

        If IsNumeric(x2) Then
            Temp = Temp + Int(x2)
        Else
            Temp = Temp + (Asc(x2) - 55)
        End If

        ' retorno 
        ConvToInt = Temp

    End Function


Encriptación utilizando la operación de bit XOR, creado por mí.

Public Function EncriptarXOR(ByVal Texto As String, ByVal Clave As Char, ByVal Accion As Single) As String

        '.................
        '...By pleoNeX
        '..................


        Dim temp() As Char
        ReDim temp(0 To Texto.Length - 1)
        Dim a As Long

        If Accion = ENCRYPT Then
            For i = 0 To Texto.Length - 1

                a = AscW(Texto(i)) Xor AscW(Clave)
                temp(i) = ChrW(a)
            Next
        ElseIf Accion = DECRYPT Then
            For i = 0 To Texto.Length - 1

                a = AscW(Texto(i)) Xor AscW(Clave)
                temp(i) = ChrW(a)
            Next
        End If


        Return CStr(temp)
    End Function


Encriptación utilizando método de suma de caracteres ASCII:

   Public Function EncriptarSUM(ByVal UserKey As String, ByVal Text As String, ByVal Action As Single) As String

        '--------------------------------------------------------------------- 
        ' EncryptString 
        ' Modificado por Harvey T. 
        '--------------------------------------------------------------------- 


        Dim UserKeyASCIIS() As Integer
        Dim TextASCIIS() As Integer
        Dim i As Integer
        Dim j As Integer
        Dim Temp As Integer
        Dim n As Integer
        Dim rtn As String = ""

        '//Get UserKey characters 
        n = Len(UserKey)
        ReDim UserKeyASCIIS(0 To n - 1)
        For i = 0 To n - 1
            UserKeyASCIIS(i) = Asc(Mid$(UserKey, i + 1, 1))
        Next

        '//Get Text characters 
        ReDim TextASCIIS(Len(Text))
        For i = 0 To Len(Text) - 1
            TextASCIIS(i) = Asc(Mid$(Text, i + 1, 1))
        Next

        '//Encryption/Decryption 
        If Action = ENCRYPT Then
            For i = 0 To Len(Text) - 1
                j = IIf(j + 1 >= n, 1, j + 1)
                Temp = TextASCIIS(i) + UserKeyASCIIS(j)
                If Temp > 255 Then
                    Temp = Temp - 255
                End If
                rtn = rtn & Chr(Temp)
            Next
        ElseIf Action = DECRYPT Then
            For i = 0 To Len(Text) - 1
                j = IIf(j + 1 >= n, 1, j + 1)
                Temp = TextASCIIS(i) - UserKeyASCIIS(j)
                If Temp < 0 Then
                    Temp = Temp + 255
                End If
                rtn = rtn & Chr(Temp)
            Next
        End If


        '//Return 
        Return rtn
    End Function


Encriptación utilizando método de generar semilla automáticamente para utilizar métodos de restas.

    Public Function EncriptarOTRO(ByVal strCadena As String, ByVal strSemilla As String, ByVal Accion As Single) As   String

        '...........................
        '......By Luis Nuñez, Chile
        '...........................

        strSemilla = Semilla(strSemilla)

        Dim lngIi1 As Long
        Dim lngIi2 As Long
        Dim i As Long
        lngIi1 = Val(Left$(strSemilla, InStr(strSemilla, ",") - 1))
        lngIi2 = Val(Mid$(strSemilla, InStr(strSemilla, ",") + 1))

        If Accion = ENCRYPT Then
            For i = 1 To Len(strCadena)

                lngIi1 = lngIi1 - i
                lngIi2 = lngIi2 + i

                If (i Mod 2) = 0 Then

                    Mid(strCadena, i, 1) = Chr((Asc(Mid$(strCadena, i, 1)) - lngIi1) And &HFF)

                Else

                    Mid(strCadena, i, 1) = Chr((Asc(Mid$(strCadena, i, 1)) + lngIi2) And &HFF)

                End If

            Next
        ElseIf Accion = DECRYPT Then
            For i = 1 To Len(strCadena)

                lngIi1 = lngIi1 - i
                lngIi2 = lngIi2 + i

                If (i Mod 2) = 0 Then

                    Mid(strCadena, i, 1) = Chr((Asc(Mid$(strCadena, i, 1)) + lngIi1) And &HFF)

                Else

                    Mid(strCadena, i, 1) = Chr((Asc(Mid$(strCadena, i, 1)) - lngIi2) And &HFF)

                End If

            Next

        End If

        EncriptarOTRO = strCadena

    End Function
    Private Function Semilla(ByVal strClave As String) As String

        Dim lngSemilla1 As Long = 0
        Dim lngSemilla2 As Long = 0
        Dim j As Long = Len(strClave)

        For i = 1 To Len(strClave)

            lngSemilla1 = lngSemilla1 + Asc(Mid$(strClave, i, 1)) * i
            lngSemilla2 = lngSemilla2 + Asc(Mid$(strClave, i, 1)) * j
            j = j - 1

        Next

        Semilla = LTrim$(Str$(lngSemilla1)) + "," + LTrim$(Str$(lngSemilla2))

    End Function


Y por el momento ya están todos los métodos que conozco actualmente, también .NET Framework incluye una función para crifrar archivos aunque no recomiendo usarla porque por ejemplo a mí siempre me ha producido un error que le produce a bastante gente.

Aquí tenéis una dll que podéis agregarla a un proyecto vuestro y utilizarla simplemente agregandole una referencia.
DLL -> Descargar
Código de fuente -> Descargar


Fuente: http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/269-encriptar-desencript
Categoría: VB9 | Ha añadido: pleonex (18-09-2009) | Autor: pleoNeX
Visiones: 1135 | Comentarios: 1 | Tags: Datos, módulo, encriptar, encriptación | Ranking: 4.0/1
Total de comentarios: 0
Solamente los usuarios registrados pueden añadir los comentarios.
[ Registrarse | Entrada ]

información sobre el antiguo Imperio Romano

Copyright Pleonet © 2017
Alojado por uCoz