Jump to content
Fórum Script Brasil
  • 0

Criptografar e decriptografar dados


fabio mazzi

Question

Pessoal é o seguinte estou utilizando a rotina abaixo descriminada junto com o meu banco de dados para criptografar as senhas dos usuarios já existentes.

TABELA USUARIOS

Campos:

Name Type NULL Default Extras Comment

Id int(11) auto_increment

id_funcionario int(11) NULL id do cadstro ddo funcionario

usuario varchar(20) NULL nome de usuario

senha varchar(100) NULL senha do usuario

lembrete varchar(35) NULL campo para lembrete de senha

logado char(1) NULL n indica se o usuario esta logado no servidor

acesso int(11) NULL 0 indica quantas vezes o usuario acessou o sistema

alterar_senha char(1) NULL s indica se o usuario devera alterar a senha no proximo logon

ultimo_acesso varchar(15) NULL

Dados:

Id id_funcionario usuario senha lembrete logado acesso alterar_senha ultimo_acesso

1 1 usuario1 123456 <NULL> s 3 s 172.21.100.254

2 2 usuario2 654321 <NULL> n 0 s <NULL>

3 3 usuario3 987654 <NULL> n 0 s <NULL>

4 4 usuario4 456789 <NULL> n 0 s <NULL>

e O SCRIPT segue abaixo:

<%
'=======================================================
'CLASSE DE CRIPTOGRAFIA DE STRINGS
'=======================================================
Class Criptografia

    '-----------------------------------------------------
    'Atributos/Constantes da Classe
    '-----------------------------------------------------
    Private dblCenterY
    Private dblCenterX
    Private LastResult
    Private LastErrDes
    Private LastErrNum 
    Private errInvalidKeyLength
    Private errInvalidKey
    Private errInvalidSize
    Private errKeyMissing
    Private errClearTextMissing
    Private errCipherTextMissing
    Private A
    Private B
    Private C
    Private D
    Private E
    Private F

    '-----------------------------------------------------
    'Procedimentos de Inicialização de Destruição da Classe
    '-----------------------------------------------------
    Private Sub Class_Initialize()
        'Inivializando as variáveis
        errInvalidKeyLength = 65101
        errInvalidKey = 65102
        errInvalidSize = 65103
        errKeyMissing = 65303
        errClearTextMissing = 65304
        errCipherTextMissing = 65305
        A = 10
        B = 11
        C = 12
        D = 13
        E = 14
        F = 15
    End Sub
    Private Sub Class_Terminate()
    End Sub

    Function QuickEncrypt(strClear, strKey)
        Dim intRet
        intRet = EncryptText(strClear, strKey)
        If intRet = -1 Then
            QuickEncrypt = "ERROR"
        Else
            QuickEncrypt = LastResult
        End If
    End Function

    Function QuickDecrypt(strCipher, strKey)
        Dim intRet
        intRet = DecryptText(strCipher, strKey)
        If intRet = -1 Then
            QuickDecrypt = "ERROR"
        Else
            QuickDecrypt = LastResult
        End If
    End Function

    Function GetStrength(strPassword)
        strPassword = CStr(strPassword)
        GetStrength = (Len(strPassword) * 8) + (Len(GetSerial) * 8)
    End Function

    Function GetSerial()
        GetSerial = Now
    End Function

    Function GetHash(strKey)
        Dim strCipher
        Dim byKey()
        ReDim byKey(Len(strKey))
        For i = 1 To Len(strKey)
            byKey(i) = Asc(Mid(strKey, i, 1))
        Next

        For i = 1 To UBound(byKey) / 2
            strCipher = strCipher & NumToHex(byKey(i) Xor byKey((UBound(byKey) - i) + 1))
        Next
        GetHash = strCipher
    End Function

    Function CreatePassword(strSeed, lngLength)
        Dim bySeed()
        Dim bySerial()
        Dim strTimeSerial
        Dim Random
        Dim lngPosition
        Dim lngSerialPosition
        strCipher = ""
        lngPosition = 1
        lngSerialPosition = 1
        ReDim bySeed(Len(strSeed))
        For i = 1 To Len(strSeed)
          bySeed(i) = Asc(Mid(strSeed, i, 1))
        Next
        strTimeSerial = GetSerial()
        ReDim bySerial(Len(strTimeSerial))
        For i = 1 To Len(strTimeSerial)
          bySerial(i) = Asc(Mid(strTimeSerial, i, 1))
        Next
        ReCenter CDbl(bySeed(lngPosition)), CDbl(bySerial(lngSerialPosition))
        lngPosition = lngPosition + 1
        lngSerialPosition = lngSerialPosition + 1
        For i = 1 To (lngLength / 2)
            Generate CDbl(bySeed(lngPosition)), CDbl(bySerial(lngSerialPosition)), False
            strCipher = strCipher & NumToHex(MakeRandom(dblCenterX, 255))
            strCipher = strCipher & NumToHex(MakeRandom(dblCenterY, 255))
            If lngPosition = Len(strSeed) Then
                lngPosition = 1
            Else
                lngPosition = lngPosition + 1
            End If
            If lngSerialPosition = Len(strTimeSerial) Then
                lngSerialPosition = 1
            Else
                lngSerialPosition = lngSerialPosition + 1
            End If
        Next
        CreatePassword = Left(strCipher, lngLength)
    End Function

    Sub ReCenter(mdblCenterY, mdblCenterX)
        dblCenterY = mdblCenterY
        dblCenterX = mdblCenterX
    End Sub

    Sub Generate(dblRadius, dblTheta, blnRad)
        Const Pi = 3.14159265358979
        Const sngMaxUpper = 2147483647
        Const sngMaxLower = -2147483648
        If blnRad = False Then
            If (dblRadius * Cos((dblTheta / 180) * Pi)) + dblCenterX > sngMaxUpper Or (dblRadius * Cos((dblTheta / 180) * Pi)) + dblCenterX < sngMaxLower Then
                ReCenter dblCenterY, 0
            Else
                dblCenterX = (dblRadius * Cos((dblTheta / 180) * Pi)) + dblCenterX
            End If
            
            If (dblRadius * Sin((dblTheta / 180) * Pi)) + dblCenterY > sngMaxUpper Or (dblRadius * Sin((dblTheta / 180) * Pi)) + dblCenterY < sngMaxLower Then
                ReCenter 0, dblCenterX
            Else
                dblCenterY = (dblRadius * Sin((dblTheta / 180) * Pi)) + dblCenterY
            End If
        Else
            If (dblRadius * Cos(dblTheta)) + dblCenterX > sngMaxUpper Or (dblRadius * Cos(dblTheta)) + dblCenterX < sngMaxLower Then
                ReCenter dblCenterY, 0
            Else
                dblCenterX = (dblRadius * Cos(dblTheta)) + dblCenterX
            End If
        
            If (dblRadius * Sin(dblTheta)) + dblCenterY > sngMaxUpper Or (dblRadius * Sin(dblTheta)) + dblCenterY < sngMaxLower Then
                ReCenter 0, dblCenterX
            Else
                dblCenterY = (dblRadius * Sin(dblTheta)) + dblCenterY
            End If
        End If
    End Sub

    Function MakeRandom(dblValue, lngMax)
        Dim lngRandom
        lngRandom = Int(dblValue Mod (lngMax + 1))
        If lngRandom > lngMax Then
            lngRandom = 0
        End If
        MakeRandom = Abs(lngRandom)
    End Function

    Sub RaiseError(lngErrNum, strErrDes)
        LastErrDes = strErrDes
        LastErrNum = lngErrNum
    End Sub

    Function EncryptText(strClear, strKey)
        Dim byClear()
        Dim byKey()
        Dim byCipher()
        Dim lngPosition
        Dim lngSerialPosition
        Dim strTimeSerial
        Dim blnSecondValue
        Dim strCipher
        Dim i
        strKey = CStr(strKey)
        strClear = CStr(strClear)
        If strKey = "" Then
            RaiseError errKeyMissing, "Key Missing"
            EncryptText = -1
            Exit Function
        End If
        If Len(strKey) <= 1 Then
            RaiseError errInvalidKeyLength, "Invalid Key Length"
            EncryptText = -1
            Exit Function
        End If
        strTimeSerial = GetSerial()
        ReDim byKey(Len(strKey))
        For i = 1 To Len(strKey)
            byKey(i) = Asc(Mid(strKey, i, 1))
        Next
        If Len(strClear) = 0 Then
            RaiseError errInvalidSize, "Text Has Zero Length"
            EncryptText = -1
            Exit Function
        End If
        ReDim byClear(Len(strClear))
        For i = 1 To Len(strClear)
            byClear(i) = Asc(Mid(strClear, i, 1))
        Next
        lngPosition = 1
        lngSerialPosition = 1
        For i = 1 To UBound(byKey) / 2
            strCipher = strCipher & NumToHex(byKey(i) Xor byKey((UBound(byKey) - i) + 1))
        Next
        lngPosition = 1
        strCipher = strCipher & NumToHex(Len(strTimeSerial) Xor byKey(lngPosition))
        lngPosition = lngPosition + 1
        For i = 1 To Len(strTimeSerial)
            strCipher = strCipher & NumToHex(byKey(lngPosition) Xor Asc(Mid(strTimeSerial, i, 1)))
            If lngPosition = UBound(byKey) Then
                lngPosition = 1
            Else
                lngPosition = lngPosition + 1
            End If
        Next
        lngPosition = 1
        lngSerialPosition = 1
        ReCenter CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1))
        lngPosition = lngPosition + 1
        lngSerialPosition = lngSerialPosition + 1
        blnSecondValue = False     
        For i = 1 To UBound(byClear)    
            If blnSecondValue = False Then
                Generate CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1)), False
                strCipher = strCipher & NumToHex(byClear(i) Xor MakeRandom(dblCenterX, 255))
                blnSecondValue = True
            Else
                strCipher = strCipher & NumToHex(byClear(i) Xor MakeRandom(dblCenterY, 255))
                blnSecondValue = False
            End If
            If lngPosition = UBound(byKey) Then
                lngPosition = 1
            Else
                lngPosition = lngPosition + 1
            End If
            If lngSerialPosition = Len(strTimeSerial) Then
                lngSerialPosition = 1
            Else
                lngSerialPosition = lngSerialPosition + 1
            End If
        Next
        LastResult = strCipher
        EncryptText = 1
        Exit Function
    End Function

    Public Function DecryptText(strCipher, strKey)
        Dim strClear
        Dim byCipher()
        Dim byKey()
        Dim strTimeSerial
        Dim strCheckKey
        Dim lngPosition
        Dim lngSerialPosition
        Dim lngCipherPosition
        Dim bySerialLength
        Dim blnSecondValue
        Dim i
        strCipher = CStr(strCipher)
        strKey = CStr(strKey)
        If Len(strCipher) = 0 Then
            RaiseError errCipherTextMissing, "Cipher Text Missing"
            DecryptText = -1
            Exit Function
        End If
        If Len(strCipher) < 10 Then
            RaiseError errInvalidSize, "Bad Text Length"
            DecryptText = -1
            Exit Function
        End If
        If Len(strKey) = 0 Then
            RaiseError errKeyMissing, "Key Missing"
            DecryptText = -1
            Exit Function
        End If
        If Len(strKey) <= 1 Then
            RaiseError errInvalidKeyLength, "Invalid Key Length"
            DecryptText = -1
            Exit Function
        End If
        ReDim byKey(Len(strKey))
        For i = 1 To Len(strKey)
            byKey(i) = Asc(Mid(strKey, i, 1))
        Next
        ReDim byCipher(Len(strCipher) / 2)
        lngCipherPosition = 1
        For i = 1 To Len(strCipher) Step 2
            byCipher(lngCipherPosition) = HexToNum(Mid(strCipher, i, 2))
            lngCipherPosition = lngCipherPosition + 1
        Next
        lngCipherPosition = 1
        For i = 1 To UBound(byKey) / 2
            strCheckKey = strCheckKey & NumToHex(byKey(i) Xor byKey((UBound(byKey) - i) + 1))
        Next
        If Left(strCipher, Len(strCheckKey)) <> strCheckKey Then
            RaiseError errInvalidKey, "Invalid Key"
            DecryptText = -1
            Exit Function
        Else
            lngCipherPosition = (Len(strCheckKey) / 2) + 1
        End If
        lngPosition = 1
        bySerialLength = byCipher(lngCipherPosition) Xor byKey(lngPosition)
        lngCipherPosition = lngCipherPosition + 1
        lngPosition = lngPosition + 1
        For i = 1 To bySerialLength
            strTimeSerial = strTimeSerial & Chr(byCipher(lngCipherPosition) Xor byKey(lngPosition))
            If lngPosition = UBound(byKey) Then
                lngPosition = 1
            Else
                lngPosition = lngPosition + 1
            End If
            lngCipherPosition = lngCipherPosition + 1
        Next
        lngPosition = 1
        lngSerialPosition = 1
        ReCenter CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1))
        lngPosition = lngPosition + 1
        lngSerialPosition = lngSerialPosition + 1
        blnSecondValue = False
        For i = 1 To UBound(byCipher) - lngCipherPosition + 1
            If blnSecondValue = False Then
                Generate CDbl(byKey(lngPosition)), Asc(Mid(strTimeSerial, lngSerialPosition, 1)), False
                strClear = strClear & Chr(byCipher(lngCipherPosition) Xor MakeRandom(dblCenterX, 255))
                blnSecondValue = True
            Else
                strClear = strClear & Chr(byCipher(lngCipherPosition) Xor MakeRandom(dblCenterY, 255))
                blnSecondValue = False
            End If
            If lngPosition = UBound(byKey) Then
                lngPosition = 1
            Else
                lngPosition = lngPosition + 1
            End If
            If lngSerialPosition = Len(strTimeSerial) Then
                lngSerialPosition = 1
            Else
                lngSerialPosition = lngSerialPosition + 1
            End If
            lngCipherPosition = lngCipherPosition + 1
        Next
        LastResult = strClear
        DecryptText = 1
        Exit Function
    End Function


    Function NumToHex(bByte)
        Dim strOne
        Dim strTwo
        strOne = CStr(Int((bByte / 16)))
        strTwo = bByte - (16 * strOne)
        If CDbl(strOne) > 9 Then
            If CDbl(strOne) = 10 Then
                strOne = "A"
            ElseIf CDbl(strOne) = 11 Then
                strOne = "B"
            ElseIf CDbl(strOne) = 12 Then
                strOne = "C"
            ElseIf CDbl(strOne) = 13 Then
                strOne = "D"
            ElseIf CDbl(strOne) = 14 Then
                strOne = "E"
            ElseIf CDbl(strOne) = 15 Then
                strOne = "F"
            End If
        End If
        
        If CDbl(strTwo) > 9 Then
            If strTwo = "10" Then
                strTwo = "A"
            ElseIf strTwo = "11" Then
                strTwo = "B"
            ElseIf strTwo = "12" Then
                strTwo = "C"
            ElseIf strTwo = "13" Then
                strTwo = "D"
            ElseIf strTwo = "14" Then
                strTwo = "E"
            ElseIf strTwo = "15" Then
                strTwo = "F"
            End If
        End If
        NumToHex = Right(strOne & strTwo, 2)
    End Function

    Function HexToNum(hexnum)
        Dim X
        Dim y
        Dim cur
        hexnum = UCase(hexnum)
        cur = CStr(Right(hexnum, 1))
        Select Case cur
            Case "A"
                y = A
            Case "B"
                y = B
            Case "C"
                y = C
            Case "D"
                y = D
            Case "E"
                y = E
            Case "F"
                y = F
            Case Else
                y = CDbl(cur)
        End Select    
        Select Case Left(hexnum, 1)
            Case "0"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "1"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "2"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "3"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "4"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "5"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "6"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "7"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "8"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "9"
                X = (16 * CInt(Left(hexnum, 1))) + y
            Case "A"
                X = 160 + y
            Case "B"
                X = 176 + y
            Case "C"
                X = 192 + y
            Case "D"
                X = 208 + y
            Case "E"
                X = 224 + y
            Case "F"
                X = 240 + y
        End Select
        HexToNum = X
    End Function
End Class%>
<!--#include file="configuracoes/conexao.asp"-->
<%
'session("banco")="intranet"
call abre_conexao()
sql = "select * from cadastro_usuarios"
Set rs_login = Server.CreateObject("ADODB.Recordset")
rs_login.CursorLocation = 3
rs_login.Open SQL, conexao
'---------------------------------------------------------------------------------------------
Dim objCriptografia
while not rs_login.eof
    Set objCriptografia = New Criptografia
    Response.Write "<br />Usuario: " & rs_login("usuario")
    Response.Write "<br />Senha: " & rs_login("senha")
    vC = objCriptografia.QuickEncrypt("'"&rs_login("senha")&"'", "%r3E9gY,gq4$2#*")
    Response.Write "<br />Senha Cript: " & vC
    vD = objCriptografia.QuickDecrypt(objCriptografia.QuickEncrypt(vD, "%r3E9gY,gq4$2#*"), "%r3E9gY,gq4$2#*")
    Response.Write "<br />Senha Decript: " & vD
    Response.Write "<br />Encriptacaoo: " & objCriptografia.QuickEncrypt("123456", "%r3E9gY,gq4$2#*")
    Response.Write "<br />Decriptacao: " & objCriptografia.QuickDecrypt(objCriptografia.QuickEncrypt("123456", "%r3E9gY,gq4$2#*"), "%r3E9gY,gq4$2#*")
    Response.Write "<br />-----------------------------------------------------------------------"
    Set objCriptografia = Nothing
    rs_login.movenext
wend
response.End()
'---------------------------------------------------------------------------------------------
%>

Quando executo o arquivo criptografar.asp traz o seguinte resultado:

Usuario: usuario1

Senha: 123456

Senha Cript: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077655B5AF8AEB3DCA0E

Senha Decript: ERROR

Encriptacaoo: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077643B6AE8DEA3E

Decriptacao: 123456

-----------------------------------------------------------------------

Usuario: usuario2

Senha: 654321

Senha Cript: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077655B2A88DEC3ACD0E

Senha Decript: ERROR

Encriptacaoo: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077643B6AE8DEA3E

Decriptacao: 123456

-----------------------------------------------------------------------

Usuario: usuario3

Senha: 987654

Senha Cript: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077655BDA58EE93DC80E

Senha Decript: ERROR

Encriptacaoo: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077643B6AE8DEA3E

Decriptacao: 123456

-----------------------------------------------------------------------

Usuario: usuario4

Senha: 456789

Senha Cript: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077655B0A88FE830C50E

Senha Decript: ERROR

Encriptacaoo: 0F5101610D163E37400B6A0A486B1C5643141505191A1248077643B6AE8DEA3E

Decriptacao: 123456

-----------------------------------------------------------------------

Minha duvida é a seguinte:

Quando pego a senha do banco de dados ele criptografa, porém ao decriptografar ele retorna ERROR, porem nos valores que são fixo pra senha ele criptografa e decriptografa normalmente.

Alguém poderia me ajudar para ver o que pode estar errado?

Grato,

Fabio Mazzi

Link to comment
Share on other sites

1 answer to this question

Recommended Posts

  • 0

repare que o objeto que você está criptografando não é o correto

vC = objCriptografia.QuickEncrypt("'"&rs_login("senha")&"'", "%r3E9gY,gq4$2#*")
    Response.Write "<br />Senha Cript: " & vC
    vD = objCriptografia.QuickDecrypt(objCriptografia.QuickEncrypt(vD, "%r3E9gY,gq4$2#*"), "%r3E9gY,gq4$2#*")
experimente
chave = "%r3E9gY,gq4$2#*"
    vC = objCriptografia.QuickEncrypt("'"&rs_login("senha")&"'", chave )
    Response.Write "<br />Senha Cript: " & vC
    vD = objCriptografia.QuickDecrypt(vC, chave)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.2k
    • Total Posts
      652k
×
×
  • Create New...