Criptografia,

Guybrush · Agosto 26, 2005

Bem, eu sou novatotenho que cuidar de um site, e ele tem que ser lacrado na segurançaterá um sistema de login e senha.Sobre a Criptografia, qual devo usar, qual metódo mais seguro?**Dicas de SEgurança e Desempenho sempre serào bem vindas!!

Mário Monteiro · Agosto 26, 2005

todos, ou a maioria dos, algoritmos prontos alguem ja tem um jeito de descriptografaro ideal seria voce criar um pra voce

Guybrush · Agosto 26, 2005

todos, ou a maioria dos, algoritmos prontos alguem ja tem um jeito de descriptografar

o ideal seria voce criar um pra voce

<{POST_SNAPBACK}>

E como eu crio ?

tem alguma base, ou lugar onde eu posssa aprender?

flw ae

ahhhhh

Acho que tive uma idéia..

usando replace, será que seria seguro ?

Mário Monteiro · Agosto 26, 2005

voce pode pegar um pronto e alterar a sua maneirase não conseguir ai não tem jeito usa ele mesmo

Guybrush · Agosto 26, 2005

voce pode pegar um pronto e alterar a sua maneira

se não conseguir ai não tem jeito usa ele mesmo

<{POST_SNAPBACK}>

<%@LANGUAGE="JAVASCRIPT" CODEPAGE="1252"%>

<%

var nome = "Alemao";

function cript(valor)

{

valor = valor.replace("a","0AFDSRADSASD");

return valor;

}

Response.Write(cript(nome));

%>

ehushushue

Guybrush · Agosto 26, 2005

valor = valor.replace("a","mn4x");valor = valor.replace("m","ll55");Ai vai dar problema, primeiro o a vai ser trocado por mn4x e depois esse m vai ser trocado por ll55então vai ficar ll55n4x quando era pra ficar apenas mn4x =|idéias ?

marcos-rj · Agosto 26, 2005

Segue um código de criptografia:

<% '#############################'sistema criptografia extrema em 64 bits usando o algoritimo BASE64 da RSA'#############################Function Cripto(StrCripto, BolAcao) 'Início de da função de criptografia. Aonde o parâmetro String é o valor que será criptografado ou descriptografado. E o parâmetro BolAcao é um valor booleano (True ou False) para indicar se deve ser criptografado (True) ou descriptografado (False).if application("Cripto_Ativa") = "Sim" thenIf BolAcao ThenCripto = EncodeBase64(StrCripto)       ElseCripto = DecodeBase64(StrCripto)End IfelseCripto = StrCriptoend ifEnd FunctionFunction EncodeBase64(inData)On Error Resume Next  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  Dim cOut  Dim sOut  Dim I  For I = 1 To Len(inData) Step 3    Dim nGroup, pOut, sGroup    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))    nGroup = Oct(nGroup)    nGroup = String(8 - Len(nGroup), "0") & nGroup    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)    sOut = sOut + pOut    If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf  Next  Select Case Len(inData) Mod 3    Case 1:      sOut = Left(sOut, Len(sOut) - 2) + "=="    Case 2:      sOut = Left(sOut, Len(sOut) - 1) + "="  End Select  EncodeBase64 = sOutEnd FunctionFunction MyASC(OneChar)  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)End Function'=============================================================='==============================================================Function DecodeBase64(ByVal base64String)On Error Resume Next  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  Dim dataLength  Dim sOut  Dim groupBegin  base64String = Replace(base64String, vbCrLf, "")  base64String = Replace(base64String, vbTab, "")  base64String = Replace(base64String, " ", "")  dataLength = Len(base64String)  If dataLength Mod 4 <> 0 Then    Err.Raise 1, "Diana Papeis", "String de criptografia com problemas. " & VBNewline & "Contate nosso suporte técnico pelo telefone (21) 9473-1227."    Exit Function  End If  For groupBegin = 1 To dataLength Step 4    Dim numDataBytes    Dim CharCounter    Dim thisChar    Dim thisData    Dim nGroup    Dim pOut    numDataBytes = 3    nGroup = 0    For CharCounter = 0 To 3      thisChar = Mid(base64String, groupBegin + CharCounter, 1)      If thisChar = "=" Then        numDataBytes = numDataBytes - 1        thisData = 0      Else        thisData = InStr(Base64, thisChar) - 1      End If      If thisData = -1 Then        Err.Raise 2, "Diana Papeis", "String de criptografia com problemas. " & VBNewline & "Contate nosso suporte técnico pelo telefone (21) 9473-1227."        Exit Function      End If      nGroup = 64 * nGroup + thisData    Next    nGroup = Hex(nGroup)    nGroup = String(6 - Len(nGroup), "0") & nGroup    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _      Chr(CByte("&H" & Mid(nGroup, 5, 2)))    sOut = sOut & Left(pOut, numDataBytes)  Next  DecodeBase64 = sOutEnd Function%>

bairro = Cripto(dados("bairro"),false)

marcos-rj · Agosto 26, 2005

Criptografia Simples de senha

ASP

[*]

[*]<%

[*]Function CriptSenha(senha)

[*]Key = "350" 'um número de 0 a 900

[*]For i = 1 to Len(senha)

[*]Char = Mid(senha,i,1)

[*]CodAsc = Asc(Char)

[*]vXor = CodAsc Xor Key

[*]HexvXor = Chr(vXor)

[*]PwdCrip = PwdCrip & HexvXor Next

[*]CriptSenha = PwdCrip

[*]End Function

[*]%>

para chamar a função:

tanto para criptografar, qto para descriptografar... se a senha estiver criptografada, ele retorna a original, e vice-versa...

<%response.write CriptSenha("senha123")%>

T+

Marcos Fernandes

Guybrush · Agosto 26, 2005

Obrigado ae! =)eu fiz meu própio esquema também aqui com js+ASPmas vo refazer olhando este que você me passou.flw

marciolvs · Novembro 19, 2008

Criptografia Simples de senha

<div class='asptop'>ASP</div><div class='aspmain'><link href = "style_images/css_asp.css" rel = "stylesheet" type = "text/css">

<%

Function CriptSenha(senha)

Key = "350" 'um número de 0 a 900

For i = 1 to Len(senha)

Char = Mid(senha,i,1)

CodAsc = Asc(Char)

vXor = CodAsc Xor Key

HexvXor = Chr(vXor)

PwdCrip = PwdCrip & HexvXor Next

CriptSenha = PwdCrip

End Function

%>

</div>

para chamar a função:

tanto para criptografar, qto para descriptografar... se a senha estiver criptografada, ele retorna a original, e vice-versa...
<%
response.write CriptSenha("senha123")
%>
T+

Marcos Fernandes

Pode me informar como seria no caso de uma insert ?

pois tentei e não deu certo...

quando ele vai ao banco ele tem q passar pelo cripto e dá erro

dedindol · Novembro 19, 2008

MD5 é uma boa saída,

faz uma busca aqui no forum por MD5 e dá uma olhada.

desisto · Novembro 19, 2008

md5 é o unico que presta

nao ha reverso

xanburzum · Novembro 19, 2008

Esta é uma simples criptografia , que utiliza um exclusivo multiplicador de chave aleatória para encriptar qualquer string ASCII. Este código contém tanto Encryption e DeCryption de 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


%>

do mesmo jeito que a criptografia ROT13, MD5 ou outras cript. onde o nivel de segurança é mais elevado...

e aqui segue um rotima em ROT13:

Public Function GerROT13(strDataString As String) As String



Dim strDataTx As String

Dim strPriKey As String

Dim strConKey As String

Dim intLenKey As Integer

Dim intLenDTX As Integer

Dim strReturn As String

Dim x As Integer

Dim y As Integer



strDataTx = Trim(strDataString)



strPriKey = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZáéíóúÁÉÍÓÚãõÃÕçÇ"

strConKey = "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLMâêîôûÂÊÎÔÛàòÀÒ&%"



intLenKey = Len(strPriKey)

intLenDTX = Len(strDataTx)



For x = 1 To intLenDTX

 For y = 1 To intLenKey

   If Mid(strDataTx, x, 1) = Mid(strPriKey, y, 1) Then

	 strReturn = strReturn & Mid(strConKey, y, 1)

	 Exit For

   Else

	 If y = intLenKey Then

	   strReturn = strReturn & Mid(strDataTx, x, 1)

	   Exit For

	 End If

   End If

 Next y

Next x



GerROT13 = strReturn



End Function

ou essa em MD5, da RSA Data Security:

<%



Private Const BITS_TO_A_BYTE = 8

Private Const BYTES_TO_A_WORD = 4

Private Const BITS_TO_A_WORD = 32



Private m_lOnBits(30)

Private m_l2Power(30)



m_lOnBits(0) = CLng(1)

m_lOnBits(1) = CLng(3)

m_lOnBits(2) = CLng(7)

m_lOnBits(3) = CLng(15)

m_lOnBits(4) = CLng(31)

m_lOnBits(5) = CLng(63)

m_lOnBits(6) = CLng(127)

m_lOnBits(7) = CLng(255)

m_lOnBits(8) = CLng(511)

m_lOnBits(9) = CLng(1023)

m_lOnBits(10) = CLng(2047)

m_lOnBits(11) = CLng(4095)

m_lOnBits(12) = CLng(8191)

m_lOnBits(13) = CLng(16383)

m_lOnBits(14) = CLng(32767)

m_lOnBits(15) = CLng(65535)

m_lOnBits(16) = CLng(131071)

m_lOnBits(17) = CLng(262143)

m_lOnBits(18) = CLng(524287)

m_lOnBits(19) = CLng(1048575)

m_lOnBits(20) = CLng(2097151)

m_lOnBits(21) = CLng(4194303)

m_lOnBits(22) = CLng(8388607)

m_lOnBits(23) = CLng(16777215)

m_lOnBits(24) = CLng(33554431)

m_lOnBits(25) = CLng(67108863)

m_lOnBits(26) = CLng(134217727)

m_lOnBits(27) = CLng(268435455)

m_lOnBits(28) = CLng(536870911)

m_lOnBits(29) = CLng(1073741823)

m_lOnBits(30) = CLng(2147483647)



m_l2Power(0) = CLng(1)

m_l2Power(1) = CLng(2)

m_l2Power(2) = CLng(4)

m_l2Power(3) = CLng(8)

m_l2Power(4) = CLng(16)

m_l2Power(5) = CLng(32)

m_l2Power(6) = CLng(64)

m_l2Power(7) = CLng(128)

m_l2Power(8) = CLng(256)

m_l2Power(9) = CLng(512)

m_l2Power(10) = CLng(1024)

m_l2Power(11) = CLng(2048)

m_l2Power(12) = CLng(4096)

m_l2Power(13) = CLng(8192)

m_l2Power(14) = CLng(16384)

m_l2Power(15) = CLng(32768)

m_l2Power(16) = CLng(65536)

m_l2Power(17) = CLng(131072)

m_l2Power(18) = CLng(262144)

m_l2Power(19) = CLng(524288)

m_l2Power(20) = CLng(1048576)

m_l2Power(21) = CLng(2097152)

m_l2Power(22) = CLng(4194304)

m_l2Power(23) = CLng(8388608)

m_l2Power(24) = CLng(16777216)

m_l2Power(25) = CLng(33554432)

m_l2Power(26) = CLng(67108864)

m_l2Power(27) = CLng(134217728)

m_l2Power(28) = CLng(268435456)

m_l2Power(29) = CLng(536870912)

m_l2Power(30) = CLng(1073741824)



Private Function LShift(lValue, iShiftBits)

If iShiftBits = 0 Then

LShift = lValue

Exit Function

ElseIf iShiftBits = 31 Then

If lValue And 1 Then

LShift = &H80000000

Else

LShift = 0

End If

Exit Function

ElseIf iShiftBits < 0 Or iShiftBits > 31 Then

Err.Raise 6

End If



If (lValue And m_l2Power(31 - iShiftBits)) Then

LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000

Else

LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))

End If

End Function



Private Function RShift(lValue, iShiftBits)

If iShiftBits = 0 Then

RShift = lValue

Exit Function

ElseIf iShiftBits = 31 Then

If lValue And &H80000000 Then

RShift = 1

Else

RShift = 0

End If

Exit Function

ElseIf iShiftBits < 0 Or iShiftBits > 31 Then

Err.Raise 6

End If



RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)



If (lValue And &H80000000) Then

RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))

End If

End Function



Private Function RotateLeft(lValue, iShiftBits)

RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))

End Function



Private Function AddUnsigned(lX, lY)

Dim lX4

Dim lY4

Dim lX8

Dim lY8

Dim lResult



lX8 = lX And &H80000000

lY8 = lY And &H80000000

lX4 = lX And &H40000000

lY4 = lY And &H40000000



lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)



If lX4 And lY4 Then

lResult = lResult Xor &H80000000 Xor lX8 Xor lY8

ElseIf lX4 Or lY4 Then

If lResult And &H40000000 Then

lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8

Else

lResult = lResult Xor &H40000000 Xor lX8 Xor lY8

End If

Else

lResult = lResult Xor lX8 Xor lY8

End If



AddUnsigned = lResult

End Function



Private Function F(x, y, z)

F = (x And y) Or ((Not x) And z)

End Function



Private Function G(x, y, z)

G = (x And z) Or (y And (Not z))

End Function



Private Function H(x, y, z)

H = (x Xor y Xor z)

End Function



Private Function I(x, y, z)

I = (y Xor (x Or (Not z)))

End Function



Private Sub FF(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub



Private Sub GG(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub



Private Sub HH(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub



Private Sub II(a, b, c, d, x, s, ac)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))

a = RotateLeft(a, s)

a = AddUnsigned(a, b)

End Sub



Private Function ConvertToWordArray(sMessage)

Dim lMessageLength

Dim lNumberOfWords

Dim lWordArray()

Dim lBytePosition

Dim lByteCount

Dim lWordCount



Const MODULUS_BITS = 512

Const CONGRUENT_BITS = 448



lMessageLength = Len(sMessage)



lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)

ReDim lWordArray(lNumberOfWords - 1)



lBytePosition = 0

lByteCount = 0

Do Until lByteCount >= lMessageLength

lWordCount = lByteCount \ BYTES_TO_A_WORD

lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)

lByteCount = lByteCount + 1

Loop



lWordCount = lByteCount \ BYTES_TO_A_WORD

lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE



lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)



lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)

lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)



ConvertToWordArray = lWordArray

End Function



Private Function WordToHex(lValue)

Dim lByte

Dim lCount



For lCount = 0 To 3

lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)

WordToHex = WordToHex & Right("0" & Hex(lByte), 2)

Next

End Function



Public Function MD5(sMessage)

Dim x

Dim k

Dim AA

Dim BB

Dim CC

Dim DD

Dim a

Dim b

Dim c

Dim d



Const S11 = 7

Const S12 = 12

Const S13 = 17

Const S14 = 22

Const S21 = 5

Const S22 = 9

Const S23 = 14

Const S24 = 20

Const S31 = 4

Const S32 = 11

Const S33 = 16

Const S34 = 23

Const S41 = 6

Const S42 = 10

Const S43 = 15

Const S44 = 21



x = ConvertToWordArray(sMessage)



a = &H67452301

b = &HEFCDAB89

c = &H98BADCFE

d = &H10325476



For k = 0 To UBound(x) Step 16

AA = a

BB = b

CC = c

DD = d



FF a, b, c, d, x(k + 0), S11, &HD76AA478

FF d, a, b, c, x(k + 1), S12, &HE8C7B756

FF c, d, a, b, x(k + 2), S13, &H242070DB

FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE

FF a, b, c, d, x(k + 4), S11, &HF57C0FAF

FF d, a, b, c, x(k + 5), S12, &H4787C62A

FF c, d, a, b, x(k + 6), S13, &HA8304613

FF b, c, d, a, x(k + 7), S14, &HFD469501

FF a, b, c, d, x(k + 8), S11, &H698098D8

FF d, a, b, c, x(k + 9), S12, &H8B44F7AF

FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1

FF b, c, d, a, x(k + 11), S14, &H895CD7BE

FF a, b, c, d, x(k + 12), S11, &H6B901122

FF d, a, b, c, x(k + 13), S12, &HFD987193

FF c, d, a, b, x(k + 14), S13, &HA679438E

FF b, c, d, a, x(k + 15), S14, &H49B40821



GG a, b, c, d, x(k + 1), S21, &HF61E2562

GG d, a, b, c, x(k + 6), S22, &HC040B340

GG c, d, a, b, x(k + 11), S23, &H265E5A51

GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA

GG a, b, c, d, x(k + 5), S21, &HD62F105D

GG d, a, b, c, x(k + 10), S22, &H2441453

GG c, d, a, b, x(k + 15), S23, &HD8A1E681

GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8

GG a, b, c, d, x(k + 9), S21, &H21E1CDE6

GG d, a, b, c, x(k + 14), S22, &HC33707D6

GG c, d, a, b, x(k + 3), S23, &HF4D50D87

GG b, c, d, a, x(k + 8), S24, &H455A14ED

GG a, b, c, d, x(k + 13), S21, &HA9E3E905

GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8

GG c, d, a, b, x(k + 7), S23, &H676F02D9

GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A



HH a, b, c, d, x(k + 5), S31, &HFFFA3942

HH d, a, b, c, x(k + 8), S32, &H8771F681

HH c, d, a, b, x(k + 11), S33, &H6D9D6122

HH b, c, d, a, x(k + 14), S34, &HFDE5380C

HH a, b, c, d, x(k + 1), S31, &HA4BEEA44

HH d, a, b, c, x(k + 4), S32, &H4BDECFA9

HH c, d, a, b, x(k + 7), S33, &HF6BB4B60

HH b, c, d, a, x(k + 10), S34, &HBEBFBC70

HH a, b, c, d, x(k + 13), S31, &H289B7EC6

HH d, a, b, c, x(k + 0), S32, &HEAA127FA

HH c, d, a, b, x(k + 3), S33, &HD4EF3085

HH b, c, d, a, x(k + 6), S34, &H4881D05

HH a, b, c, d, x(k + 9), S31, &HD9D4D039

HH d, a, b, c, x(k + 12), S32, &HE6DB99E5

HH c, d, a, b, x(k + 15), S33, &H1FA27CF8

HH b, c, d, a, x(k + 2), S34, &HC4AC5665



II a, b, c, d, x(k + 0), S41, &HF4292244

II d, a, b, c, x(k + 7), S42, &H432AFF97

II c, d, a, b, x(k + 14), S43, &HAB9423A7

II b, c, d, a, x(k + 5), S44, &HFC93A039

II a, b, c, d, x(k + 12), S41, &H655B59C3

II d, a, b, c, x(k + 3), S42, &H8F0CCC92

II c, d, a, b, x(k + 10), S43, &HFFEFF47D

II b, c, d, a, x(k + 1), S44, &H85845DD1

II a, b, c, d, x(k + 8), S41, &H6FA87E4F

II d, a, b, c, x(k + 15), S42, &HFE2CE6E0

II c, d, a, b, x(k + 6), S43, &HA3014314

II b, c, d, a, x(k + 13), S44, &H4E0811A1

II a, b, c, d, x(k + 4), S41, &HF7537E82

II d, a, b, c, x(k + 11), S42, &HBD3AF235

II c, d, a, b, x(k + 2), S43, &H2AD7D2BB

II b, c, d, a, x(k + 9), S44, &HEB86D391



a = AddUnsigned(a, AA)

b = AddUnsigned(b, BB)

c = AddUnsigned(c, CC)

d = AddUnsigned(d, DD)

Next



MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))

End Function

%>

Lembre-se que tambem existe componentes para isso.

marciolvs · Novembro 20, 2008

Esta é uma simples criptografia , que utiliza um exclusivo multiplicador de chave aleatória para encriptar qualquer string ASCII. Este código contém tanto Encryption e DeCryption de algoritmos assim tudo o que você precisa fazer é incluir este código na sua página

Lembre-se que tambem existe componentes para isso.

Entendi quase tudo, mas onde indigo o campo que irá ser cript. ?

Seria ex: response.write MD5(minhavar)

Aqui num funcou...

desisto · Novembro 20, 2008

ela é propria pra criptografar senhas e chaves e nao ha reverso

ate o presente momento nao vi nenhum caso de quebra de senha com md5

ta ai a funcao

Private Const BITS_TO_A_BYTE=8
Private Const BYTES_TO_A_WORD=4
Private Const BITS_TO_A_WORD=32
Private m_lOnBits(30)
Private m_l2Power(30)
m_lOnBits(0)=CLng(1)
m_lOnBits(1)=CLng(3)
m_lOnBits(2)=CLng(7)
m_lOnBits(3)=CLng(15)
m_lOnBits(4)=CLng(31)
m_lOnBits(5)=CLng(63)
m_lOnBits(6)=CLng(127)
m_lOnBits(7)=CLng(255)
m_lOnBits(8)=CLng(511)
m_lOnBits(9)=CLng(1023)
m_lOnBits(10)=CLng(2047)
m_lOnBits(11)=CLng(4095)
m_lOnBits(12)=CLng(8191)
m_lOnBits(13)=CLng(16383)
m_lOnBits(14)=CLng(32767)
m_lOnBits(15)=CLng(65535)
m_lOnBits(16)=CLng(131071)
m_lOnBits(17)=CLng(262143)
m_lOnBits(18)=CLng(524287)
m_lOnBits(19)=CLng(1048575)
m_lOnBits(20)=CLng(2097151)
m_lOnBits(21)=CLng(4194303)
m_lOnBits(22)=CLng(8388607)
m_lOnBits(23)=CLng(16777215)
m_lOnBits(24)=CLng(33554431)
m_lOnBits(25)=CLng(67108863)
m_lOnBits(26)=CLng(134217727)
m_lOnBits(27)=CLng(268435455)
m_lOnBits(28)=CLng(536870911)
m_lOnBits(29)=CLng(1073741823)
m_lOnBits(30)=CLng(2147483647)

m_l2Power(0)=CLng(1)
m_l2Power(1)=CLng(2)
m_l2Power(2)=CLng(4)
m_l2Power(3)=CLng(8)
m_l2Power(4)=CLng(16)
m_l2Power(5)=CLng(32)
m_l2Power(6)=CLng(64)
m_l2Power(7)=CLng(128)
m_l2Power(8)=CLng(256)
m_l2Power(9)=CLng(512)
m_l2Power(10)=CLng(1024)
m_l2Power(11)=CLng(2048)
m_l2Power(12)=CLng(4096)
m_l2Power(13)=CLng(8192)
m_l2Power(14)=CLng(16384)
m_l2Power(15)=CLng(32768)
m_l2Power(16)=CLng(65536)
m_l2Power(17)=CLng(131072)
m_l2Power(18)=CLng(262144)
m_l2Power(19)=CLng(524288)
m_l2Power(20)=CLng(1048576)
m_l2Power(21)=CLng(2097152)
m_l2Power(22)=CLng(4194304)
m_l2Power(23)=CLng(8388608)
m_l2Power(24)=CLng(16777216)
m_l2Power(25)=CLng(33554432)
m_l2Power(26)=CLng(67108864)
m_l2Power(27)=CLng(134217728)
m_l2Power(28)=CLng(268435456)
m_l2Power(29)=CLng(536870912)
m_l2Power(30)=CLng(1073741824)

Private Function LShift(lValue,iShiftBits)
  If iShiftBits=0 Then
	LShift=lValue
	Exit Function
  ElseIf iShiftBits=31 Then
	If lValue And 1 Then
	  LShift=&H80000000
	Else
	  LShift=0
	End If
	Exit Function
  ElseIf iShiftBits<0 Or iShiftBits>31 Then
	Err.Raise 6
  End If

  If (lValue And m_l2Power(31-iShiftBits)) Then
	LShift=((lValue And m_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits)) Or &H80000000
  Else
	LShift=((lValue And m_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
  End If
End Function

Private Function RShift(lValue,iShiftBits)
  If iShiftBits=0 Then
	RShift=lValue
	Exit Function
  ElseIf iShiftBits=31 Then
	If lValue And &H80000000 Then
	  RShift=1
	Else
	  RShift=0
	End If
	Exit Function
  ElseIf iShiftBits<0 Or iShiftBits>31 Then
	Err.Raise 6
  End If
  
  RShift=(lValue And &H7FFFFFFE)\m_l2Power(iShiftBits)

  If (lValue And &H80000000) Then
	RShift=(RShift Or (&H40000000\m_l2Power(iShiftBits-1)))
  End If
End Function

Private Function RotateLeft(lValue,iShiftBits)
  RotateLeft=LShift(lValue,iShiftBits) Or RShift(lValue,(32-iShiftBits))
End Function

Private Function AddUnsigned(lX,lY)
  Dim lX4
  Dim lY4
  Dim lX8
  Dim lY8
  Dim lResult

  lX8=lX And &H80000000
  lY8=lY And &H80000000
  lX4=lX And &H40000000
  lY4=lY And &H40000000

  lResult=(lX And &H3FFFFFFF)+(lY And &H3FFFFFFF)

  If lX4 And lY4 Then
	lResult=lResult Xor &H80000000 Xor lX8 Xor lY8
  ElseIf lX4 Or lY4 Then
	If lResult And &H40000000 Then
	  lResult=lResult Xor &HC0000000 Xor lX8 Xor lY8
	Else
	  lResult=lResult Xor &H40000000 Xor lX8 Xor lY8
	End If
  Else
	lResult=lResult Xor lX8 Xor lY8
  End If

  AddUnsigned=lResult
End Function

Private Function F(x,y,z)
  F=(x And y) Or ((Not x) And z)
End Function

Private Function G(x,y,z)
  G=(x And z) Or (y And (Not z))
End Function

Private Function H(x,y,z)
  H=(x Xor y Xor z)
End Function

Private Function L(x,y,z)
  L=(y Xor (x Or (Not z)))
End Function

Private Sub FF(a,b,c,d,x,s,ac)
  a=AddUnsigned(a,AddUnsigned(AddUnsigned(F(b,c,d),x),ac))
  a=RotateLeft(a,s)
  a=AddUnsigned(a,b)
End Sub

Private Sub GG(a,b,c,d,x,s,ac)
  a=AddUnsigned(a,AddUnsigned(AddUnsigned(G(b,c,d),x),ac))
  a=RotateLeft(a,s)
  a=AddUnsigned(a,b)
End Sub

Private Sub HH(a,b,c,d,x,s,ac)
  a=AddUnsigned(a,AddUnsigned(AddUnsigned(H(b,c,d),x),ac))
  a=RotateLeft(a,s)
  a=AddUnsigned(a,b)
End Sub

Private Sub II(a,b,c,d,x,s,ac)
  a=AddUnsigned(a,AddUnsigned(AddUnsigned(L(b,c,d),x),ac))
  a=RotateLeft(a,s)
  a=AddUnsigned(a,b)
End Sub

Private Function ConvertToWordArray(sMessage)
  Dim lMessageLength
  Dim lNumberOfWords
  Dim lWordArray()
  Dim lBytePosition
  Dim lByteCount
  Dim lWordCount
  Dim lByteValue	' need these variables to handle byte value and input argument type
  Dim lMessageType

  Const MODULUS_BITS=512
  Const CONGRUENT_BITS=448
  
  lMessageType=Vartype(sMessage)
  Select Case lMessageType	' strings or Variant Byte Arrays: nothing else!
	Case 8	: lMessageLength=Len(sMessage)
	Case 8209 : lMessageLength=LenB(sMessage)
	Case Else Err.Raise -1,"MD5","Unknown Type passed to MD5 function"
  End Select
  
  lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)\BITS_TO_A_BYTE))\(MODULUS_BITS\BITS_TO_A_BYTE))+1)*(MODULUS_BITS\BITS_TO_A_WORD)
  ReDim lWordArray(lNumberOfWords-1)
  
  lBytePosition=0
  lByteCount=0
  Do Until lByteCount >=lMessageLength
	lWordCount=lByteCount\BYTES_TO_A_WORD
	lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
	Select Case lMessageType	' get the next byte value
	  Case 8	: lByteValue = Asc (Mid (sMessage,lByteCount+1,1))
	  Case 8209 : lByteValue = AscB(MidB(sMessage,lByteCount+1,1))
	End Select
	lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(lByteValue,lBytePosition)
	lByteCount=lByteCount+1
  Loop

  lWordCount=lByteCount\BYTES_TO_A_WORD
  lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE

  lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(&H80,lBytePosition)

  lWordArray(lNumberOfWords-2)=LShift(lMessageLength,3)
  lWordArray(lNumberOfWords-1)=RShift(lMessageLength,29)
  
  ConvertToWordArray=lWordArray
End Function

Private Function WordToHex(lValue)
  Dim lByte
  Dim lCount
  
  For lCount=0 To 3
	lByte=RShift(lValue,lCount*BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE-1)
	WordToHex=WordToHex & Right("0" & Hex(lByte),2)
  Next
End Function

Public Function MD5(sMessage)
  Dim x
  Dim k
  Dim AA
  Dim BB
  Dim CC
  Dim DD
  Dim a
  Dim b
  Dim c
  Dim d
  
  Const S11=7
  Const S12=12
  Const S13=17
  Const S14=22
  Const S21=5
  Const S22=9
  Const S23=14
  Const S24=20
  Const S31=4
  Const S32=11
  Const S33=16
  Const S34=23
  Const S41=6
  Const S42=10
  Const S43=15
  Const S44=21

  x=ConvertToWordArray(sMessage)
  
  a=&H67452301
  b=&HEFCDAB89
  c=&H98BADCFE
  d=&H10325476

  For k=0 To UBound(x) Step 16
	AA=a
	BB=b
	CC=c
	DD=d

	FF a,b,c,d,x(k+0),S11,&HD76AA478
	FF d,a,b,c,x(k+1),S12,&HE8C7B756
	FF c,d,a,b,x(k+2),S13,&H242070DB
	FF b,c,d,a,x(k+3),S14,&HC1BDCEEE
	FF a,b,c,d,x(k+4),S11,&HF57C0FAF
	FF d,a,b,c,x(k+5),S12,&H4787C62A
	FF c,d,a,b,x(k+6),S13,&HA8304613
	FF b,c,d,a,x(k+7),S14,&HFD469501
	FF a,b,c,d,x(k+8),S11,&H698098D8
	FF d,a,b,c,x(k+9),S12,&H8B44F7AF
	FF c,d,a,b,x(k+10),S13,&HFFFF5BB1
	FF b,c,d,a,x(k+11),S14,&H895CD7BE
	FF a,b,c,d,x(k+12),S11,&H6B901122
	FF d,a,b,c,x(k+13),S12,&HFD987193
	FF c,d,a,b,x(k+14),S13,&HA679438E
	FF b,c,d,a,x(k+15),S14,&H49B40821

	GG a,b,c,d,x(k+1),S21,&HF61E2562
	GG d,a,b,c,x(k+6),S22,&HC040B340
	GG c,d,a,b,x(k+11),S23,&H265E5A51
	GG b,c,d,a,x(k+0),S24,&HE9B6C7AA
	GG a,b,c,d,x(k+5),S21,&HD62F105D
	GG d,a,b,c,x(k+10),S22,&H2441453
	GG c,d,a,b,x(k+15),S23,&HD8A1E681
	GG b,c,d,a,x(k+4),S24,&HE7D3FBC8
	GG a,b,c,d,x(k+9),S21,&H21E1CDE6
	GG d,a,b,c,x(k+14),S22,&HC33707D6
	GG c,d,a,b,x(k+3),S23,&HF4D50D87
	GG b,c,d,a,x(k+8),S24,&H455A14ED
	GG a,b,c,d,x(k+13),S21,&HA9E3E905
	GG d,a,b,c,x(k+2),S22,&HFCEFA3F8
	GG c,d,a,b,x(k+7),S23,&H676F02D9
	GG b,c,d,a,x(k+12),S24,&H8D2A4C8A
		
	HH a,b,c,d,x(k+5),S31,&HFFFA3942
	HH d,a,b,c,x(k+8),S32,&H8771F681
	HH c,d,a,b,x(k+11),S33,&H6D9D6122
	HH b,c,d,a,x(k+14),S34,&HFDE5380C
	HH a,b,c,d,x(k+1),S31,&HA4BEEA44
	HH d,a,b,c,x(k+4),S32,&H4BDECFA9
	HH c,d,a,b,x(k+7),S33,&HF6BB4B60
	HH b,c,d,a,x(k+10),S34,&HBEBFBC70
	HH a,b,c,d,x(k+13),S31,&H289B7EC6
	HH d,a,b,c,x(k+0),S32,&HEAA127FA
	HH c,d,a,b,x(k+3),S33,&HD4EF3085
	HH b,c,d,a,x(k+6),S34,&H4881D05
	HH a,b,c,d,x(k+9),S31,&HD9D4D039
	HH d,a,b,c,x(k+12),S32,&HE6DB99E5
	HH c,d,a,b,x(k+15),S33,&H1FA27CF8
	HH b,c,d,a,x(k+2),S34,&HC4AC5665

	II a,b,c,d,x(k+0),S41,&HF4292244
	II d,a,b,c,x(k+7),S42,&H432AFF97
	II c,d,a,b,x(k+14),S43,&HAB9423A7
	II b,c,d,a,x(k+5),S44,&HFC93A039
	II a,b,c,d,x(k+12),S41,&H655B59C3
	II d,a,b,c,x(k+3),S42,&H8F0CCC92
	II c,d,a,b,x(k+10),S43,&HFFEFF47D
	II b,c,d,a,x(k+1),S44,&H85845DD1
	II a,b,c,d,x(k+8),S41,&H6FA87E4F
	II d,a,b,c,x(k+15),S42,&HFE2CE6E0
	II c,d,a,b,x(k+6),S43,&HA3014314
	II b,c,d,a,x(k+13),S44,&H4E0811A1
	II a,b,c,d,x(k+4),S41,&HF7537E82
	II d,a,b,c,x(k+11),S42,&HBD3AF235
	II c,d,a,b,x(k+2),S43,&H2AD7D2BB
	II b,c,d,a,x(k+9),S44,&HEB86D391

	a=AddUnsigned(a,AA)
	b=AddUnsigned(b,BB)
	c=AddUnsigned(c,CC)
	d=AddUnsigned(d,DD)
  Next
  
  MD5=LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
End Function

Arquivado

Criptografia,

Recommended Posts

Guybrush 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

Guybrush 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

Guybrush 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Guybrush 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

marcos-rj 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

marcos-rj 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Guybrush 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

marciolvs 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

dedindol 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

desisto 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

marciolvs 1

Compartilhar este post

Link para o post

Compartilhar em outros sites

desisto 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

PHP+Codeigniter - Dúvida em Relação a Teclas

Conexão mysql com outro domínio

[Resolvido] JavaScript - Exibir logo dentro da Tabela html

Fóruns

Tempo Real

Informação importante