[Resolvido] Criptografia simples

Tentei com a MD5, ms ela aumenta demais os caracteres e acaba não aceitando valores maiores.

aumenta o tamanho da coluna no banco!

Ted K', obrigado pela resposta, mas não será viável desta forma.

Pretendo criptografar todos os dados gravados no BD. O volume de informações será muito grande e o BD ficaria absurdamente grande fazendo desta forma.

Além disso, precisarei também descriptografar para exibir as informações na tela.

[]'s

hum... criptografar tudo não aconselho, mais...

o MD5 é o ideal para isso, pensou em colocar senha no banco?

Tentei outras opções mais simples que encontrei no fórum, mas dão erro com caracteres acentuados.

poste quais encontrou e os erros, tratar caracteres é um pouco mais simples!

Ted K' mais uma vez obrigado.

A questão de criptografar tudo é que será um sistema de controle financeiro de um cliente e uma das exigências deles é que fosse impossível ler os dados no BD.

O erro que ocorre quando tento criptografar string com acento é:

>
Microsoft VBScript runtime error '800a0005'

Invalid procedure call or argument: 'Chr'

/teste_cript.asp, line 19

O código usado é:

<%

Function Crypt(Word)
Dim NewWord, Counter, RFactor

NewWord = ""

For Counter = 1 To Len(Word)
RFactor = Int(Rnd(-1 Counter) 10 - 5)
NewWord = NewWord + Chr(RFactor + Asc(Mid(Word, Counter, 1))) ---> Linha 19
Next

Crypt = NewWord

End Function

Function DeCrypt(Word)
Dim NewWord, Counter, RFactor

NewWord = ""

For Counter = 1 To Len(Word)
RFactor = Int(Rnd(-1 Counter) 10 - 5)
NewWord = NewWord + Chr(Asc(Mid(Word, Counter, 1)) - RFactor)
Next

DeCrypt = NewWord

End Function

Function DBInput(Parm1)

DBInput = Replace(Parm1, "'", "´")

End Function
%>

testei e rodou normal

se possível coloque on-line para ver o erro!

<%@ Language="VBScript" %>
<%
Function Crypt(Word)
Dim NewWord, Counter, RFactor
NewWord = ""

For Counter = 1 To Len(Word)
RFactor = Int(Rnd(-1 Counter) 10 - 5)
NewWord = NewWord + Chr(RFactor + Asc(Mid(Word, Counter, 1)))
Next
Crypt = NewWord
End Function

Function DeCrypt(Word)
Dim NewWord, Counter, RFactor
NewWord = ""

For Counter = 1 To Len(Word)
RFactor = Int(Rnd(-1 Counter) 10 - 5)
NewWord = NewWord + Chr(Asc(Mid(Word, Counter, 1)) - RFactor)
Next
DeCrypt = NewWord
End Function

Function DBInput(Parm1)
DBInput = Replace(Parm1, "'", "´")
End Function

Response.Write(Crypt("Acentuação errada é àãò"))
%>

só lembarndo existe componentes que fazem isso tb. e abaixo uma simples criptografia , que utiliza um exclusivo multiplicador de chave aleatória para encriptar. Este código contém tanto Encryption e DeCryption algoritmos assim tudo o que você precisa fazer é incluir este código na sua página

<%
'### Para criptografar / descriptografar inclua este código na sua página
'### strMyEncryptedString = EncryptString(strString)
'### strMyDecryptedString = DeCryptString(strMyEncryptedString)

Private Function EncryptString(strString)

Dim CharHexSet, intStringLen, strTemp, strRAW, i, intKey, intOffSet
Randomize Timer

intKey = Round((RND * 1000000) + 1000000) '##### Key Bitsize
intOffSet = Round((RND * 1000000) + 1000000) '##### KeyOffSet Bitsize

If IsNull(strString) = False Then
strRAW = strString
intStringLen = Len(strRAW)

For i = 0 to intStringLen - 1
strTemp = Left(strRAW, 1)
strRAW = Right(strRAW, Len(strRAW) - 1)
CharHexSet = CharHexSet & Hex(Asc(strTemp) * intKey) & Hex(intKey)
Next

EncryptString = CharHexSet & "|" & Hex(intOffSet + intKey) & "|" & Hex(intOffSet)
Else
EncryptString = ""
End If
End Function

Private Function DeCryptString(strCryptString)

Dim strRAW, arHexCharSet, i, intKey, intOffSet, strRawKey, strHexCrypData

strRawKey = Right(strCryptString, Len(strCryptString) - InStr(strCryptString, "|"))
intOffSet = Right(strRawKey, Len(strRawKey) - InStr(strRawKey,"|"))
intKey = HexConv(Left(strRawKey, InStr(strRawKey, "|") - 1)) - HexConv(intOffSet)
strHexCrypData = Left(strCryptString, Len(strCryptString) - (Len(strRawKey) + 1))

arHexCharSet = Split(strHexCrypData, Hex(intKey))

For i=0 to UBound(arHexCharSet)
strRAW = strRAW & Chr(HexConv(arHexCharSet(i))/intKey)
Next

DeCryptString = strRAW
End Function

Private Function HexConv(hexVar)
Dim hxx, hxx_var, multiply
IF hexVar <> "" THEN
hexVar = UCASE(hexVar)
hexVar = StrReverse(hexVar)
DIM hx()
REDIM hx(LEN(hexVar))
hxx = 0
hxx_var = 0
FOR hxx = 1 TO LEN(hexVar)
IF multiply = "" THEN multiply = 1
hx(hxx) = mid(hexVar,hxx,1)
hxx_var = (get_hxno(hx(hxx)) * multiply) + hxx_var
multiply = (multiply * 16)
NEXT
hexVar = hxx_var
HexConv = hexVar
END IF
End Function

Private Function get_hxno(ghx)
If ghx = "A" Then
ghx = 10
ElseIf ghx = "B" Then
ghx = 11
ElseIf ghx = "C" Then
ghx = 12
ElseIf ghx = "D" Then
ghx = 13
ElseIf ghx = "E" Then
ghx = 14
ElseIf ghx = "F" Then
ghx = 15
End If
get_hxno = ghx
End Function

%>

xanburzum, obrigado pela sugestão, mas neste caso caio no problema de tamanho.

A criptografia da string "Teste de encriptação" resulta em:

78C0A2C17001F9130C3B17001FA550DED17001FA6C0E0C17001F9130C3B17001F2E003E017001F8F

C0C1C17001F9130C3B17001F2E003E017001F9130C3B17001F9E20D5217001F8E50BFD17001FA3E0D

CE17001F96F0CB717001FA100D9017001FA6C0E0C17001F8B70BBF17001F36A049A17001F325043D1

7001F47E060E17001F495062D17001F46705EF17001F54D072517001F36A049A17001F325043D1700

1F47E060E17001F47E060E17001F4F106A917001F54D072517001F9F90D7117001F|2EC4CD|17C4AE

Enquanto no método que eu citei acima, o resultado com a mesma string é:

Qgwqh_g cjgtinq]!'552;%!/.2?r

Como eu disse anteriormente, preciso criptografar todos os dados por exigência do cliente, apenas para que não seja possível ler os dados no BD.

Consegui resolver o problema do erro dos acentos aplicando um Server.HTMLEncode na variável.

Só resta saber se esta codificação não irá gerar novos problemas no futuro, ms acredito que não.

Obrigado também ao Ted k', pois a idéia do HTMLEncode partiu da idéia dele de substituir caracteres.

[]'s

pronto man, mais como te disse, comigo não deu erro, estranho!!

Ted k', tb não entendi pq comigo deu erro e com você não... ms... o q importa é q ta resolvido.

Valeu.

[]'s