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:
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?
Question
fabio mazzi
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
e O SCRIPT segue abaixo:
Quando executo o arquivo criptografar.asp traz o seguinte resultado:
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
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.