Galera,

estou aqui no trabalho num tédio infeliz, então resolvi fazer um post que pode ser de utilidade a comunidade XTibiana.

Este algoritmo que eu tomei como base é um meio de criptografia bem simples, porem bem funcional.

Espero que ajudem a todos este codigo foi escrito por mim, então qualquer duvida post abaixo que eu esclareço para vocês

Vlw

'---------------------------------------------------------------------------------------
' Module    : Krypto
' DateTime  : 16/11/2006 16:04
' Author    : Sprit
' Purpose   : Classe de Kriptografia de Textos
'---------------------------------------------------------------------------------------

'chave de criptografia
Const KRYPTOKEY = "AfCuD1¿½!@#$%ÄKLEODCVNIerfwpnb1pihdf@#%$()^]ç;/:paosudgf'!@#$%¨+" 'esta chave pode ser qualquer coisa, letras numeros simbolos ai depende!!! =)
   
'-------------------------------------------------------------------------------------
' Procedure : Encripty
' DateTime  : 16/11/2006 16:03
' Author    : Sprit
' Purpose   : Encriptar textos p/ seg de database
'---------------------------------------------------------------------------------------
'
Public Function Encripty(lpValue As String) As String
   

   
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'declaração de variaveis
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       Dim lpTemp As Integer
       Dim lpLenghtOfKey As Integer
       Dim lpLenghtofValue As Integer
       Dim lpKeyAsc() As Integer
       Dim lpValueAsc() As Integer
       Dim I As Integer
       Dim J As Integer
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'pegando o valor do lenghtkey
       lpLenghtOfKey = Len(KRYPTOKEY)
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'pegando o valor do lenghtvalue
       lpLenghtofValue = Len(lpValue)
       
           If lpLenghtofValue < 1 Then
               Exit Function
           End If
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'redimensiona o keyasc
       ReDim lpKeyAsc(0 To lpLenghtOfKey)
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'redimensiona o valor
       ReDim lpValueAsc(0 To lpLenghtofValue)
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'grava o valor a ser encriptado
       For I = 0 To lpLenghtofValue - 1
           lpValueAsc(I) = Asc(Mid(lpValue, I + 1, 1))
       Next I
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'grava o valor da chave
       For I = 0 To lpLenghtOfKey - 1
           lpKeyAsc(I) = Asc(Mid(KRYPTOKEY, I + 1, 1))
       Next I
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       '   Algoritmo para encriptar o texto
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
           For I = 0 To lpLenghtofValue - 1
               
               If J = lpLenghtOfKey - 1 Then
                   J = 0
               Else
                   J = J + 1
               End If
               

               
                   If lpValueAsc(I) + lpKeyAsc(J) > 255 Then
                       lpTemp = (lpValueAsc(I) + lpKeyAsc(J)) - 255
                   Else
                       lpTemp = (lpValueAsc(I) + lpKeyAsc(J))
                   End If
                   
           Encripty = Encripty & Chr(lpTemp)
           
           Next I
           
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
           Exit Function

'tratamento de erros
ErrHand:
   MsgBox "Failed to encript text using the specified key!", vbCritical
       
   End Function

'---------------------------------------------------------------------------------------
' Procedure : Decripty
' DateTime  : 16/11/2006 15:40
' Author    : Sprit
' Purpose   : Desencriptar Textos usando a chave especificada
'---------------------------------------------------------------------------------------
'
Public Function Decripty(lpValue As String) As String

On Error GoTo ErrHand

       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'declaração de variaveis
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       Dim lpTemp As Integer
       Dim lpLenghtOfKey As Integer
       Dim lpLenghtofValue As Integer
       Dim lpKeyAsc() As Integer
       Dim lpValueAsc() As Integer
       Dim I As Integer
       Dim J As Integer
       Dim EncryptedValue() As String
       
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'pegando o valor do lenghtkey
       lpLenghtOfKey = Len(KRYPTOKEY)
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'pegando o valor do lenghtvalue
       lpLenghtofValue = Len(lpValue)
       
           If lpLenghtofValue < 1 Then
               Exit Function
           End If
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'redimensiona o keyasc
       ReDim lpKeyAsc(0 To lpLenghtOfKey)
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'redimensiona o valor
       ReDim lpValueAsc(0 To lpLenghtofValue)
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'grava o valor a ser encriptado
       For I = 0 To lpLenghtofValue - 1
           lpValueAsc(I) = Asc(Mid(lpValue, I + 1, 1))
       Next I
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       'grava o valor da chave
       For I = 0 To lpLenghtOfKey - 1
           lpKeyAsc(I) = Asc(Mid(KRYPTOKEY, I + 1, 1))
       Next I
       '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
           '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
           '    algoritmo para desencriptar o texto
           '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
           For I = 0 To lpLenghtofValue - 1
               
               If J = lpLenghtOfKey - 1 Then
                   J = 0
               Else
                   J = J + 1
               End If
                   
                   If lpValueAsc(I) - lpKeyAsc(J) < 0 Then
                       lpTemp = (lpValueAsc(I) - lpKeyAsc(J)) + 255
                   Else
                       lpTemp = (lpValueAsc(I) - lpKeyAsc(J))
                   End If
                   
           Decripty = Decripty & Chr(lpTemp)
           
           Next I
           '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
           '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
       
       Exit Function
       
'tratamento de erros
ErrHand:
   MsgBox "Failed to decript text using the specified key!", vbCritical
   
       
   End Function

pra que serve issu? :embarrest:

pra que serve issu? :embarrest:

<{POST_SNAPBACK}>

Digamos que eu seu passase:

King Mestre CPI como parametro

ela me retornaria o seu nick cifrado tipo

±¬ã«Q

#”´•‰E›• que é na verdade seu nick encriptado,

e se eu passase

±¬ã«Q

#”´•‰E›•

ele me retornaria

King Mestre CPI

Muito bom para quem está querendo aprender isto.

Eu estou agora tentando para MD5 muitos falam que é impossivel mas tem sites que desencryptam MD5