• Olá Visitante, se gosta do forum e pretende contribuir com um donativo para auxiliar nos encargos financeiros inerentes ao alojamento desta plataforma, pode encontrar mais informações sobre os várias formas disponíveis para o fazer no seguinte tópico: leia mais... O seu contributo é importante! Obrigado.

[VB ] classe para criptografia

Dark_KinG

GF Prata
Membro Inactivo
Entrou
Nov 12, 2007
Mensagens
210
Gostos Recebidos
1
Código:
+--------------------------+
|  CLASSE clsCriptografia  |
+--------------------------+

Public Function CriptSenha(Psenha As String) As Variant
    Dim v_sqlerrm As String
    Dim SenhaCript As String
    Dim var1 As String
    Const MIN_ASC = 32
    Const MAX_ASC = 126
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1
    
    chave = 2001 ''qualquer nº para montar o algorítimo da criptografia
    Dim offset As Long
    Dim str_len As Integer
    Dim i As Integer
    Dim ch As Integer
        
    to_text = ""
    offset = NumericPassword(chave)
    Rnd -1
    Randomize offset
    str_len = Len(Psenha)
    For i = 1 To str_len
        ch = Asc(Mid$(Psenha, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch + offset) Mod NUM_ASC)
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
    
    CriptSenha = to_text
End Function

Public Function DeCriptSenha(Psenha As String) As Variant

Dim v_sqlerrm As String
Dim SenhaCript As String

Dim var1 As String

Const MIN_ASC = 32  ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

chave = 2001 ''qualquer nº para montar o algorítimo da criptografia
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
 
to_text = ""
offset = NumericPassword(chave)
Rnd -1
Randomize offset
str_len = Len(Psenha)
For i = 1 To str_len
    ch = Asc(Mid$(Psenha, i, 1))
    If ch >= MIN_ASC And ch <= MAX_ASC Then
        ch = ch - MIN_ASC
        offset = Int((NUM_ASC + 1) * Rnd)
        ch = ((ch - offset) Mod NUM_ASC)
        If ch < 0 Then ch = ch + NUM_ASC
        ch = ch + MIN_ASC
        to_text = to_text & Chr$(ch)
    End If
Next i

DeCriptSenha = to_text
    
End Function

Private Function NumericPassword(ByVal password As String) As Long
    Dim value As Long
    Dim ch As Long
    Dim shift1 As Long
    Dim shift2 As Long
    Dim i As Integer
    Dim str_len As Integer

    str_len = Len(password)
    For i = 1 To str_len
        ' Adiciona a próxima letra
        ch = Asc(Mid$(password, i, 1))
        value = value Xor (ch * 2 ^ shift1)
        value = value Xor (ch * 2 ^ shift2)

        ' Change the shift offsets.
        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = value
End Function

+---------------------------+
|  Exemplo de Criptografia  |
+---------------------------+
Dim Cript As New clsCriptografia
Dim StrCampo as String

StrCampo = Cript.CriptSen
 
Topo