No tenia nada que hacer y ademas al fijarme en el post donde publica Sharki su proyecto Personal Algorith el cual solo crea un entador por caracteres estaticos desidi crear un Encoder and decoder o mejor conosidos como

Encryptador con su respectivo desencrypotador

Solo que este SI FUNCIONA POR CONTRASEÑA para Encryptar/Desencryptar los datos (Solo es usada para encryptar/desencryptar de Hecho asi que no seria realmente una Contraseña xP).

Es un codigo Sencillo!¡.

 
''   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
 
Option Explicit
Enum tAcciones
    Encryptar = 0
    Desencryptar
End Enum
Public Sub DecodeEncodeString(ByRef Data As String, Pass As String, Optional Accion As tAcciones = Encryptar)
Dim PosPass             As Long
Dim CharData            As String * 1
Dim i                   As Long
    If Pass <> "" Then
        For i = 1 To Len(Data)
            CharData = Mid(Data, i, 1)
            PosPass = IIf((PosPass + 1) > Len(Pass), 1, PosPass + 1)
            Mid(Data, i, 1) = DecodeEncodeChar(CharData, Pass, PosPass, Accion) '    //  Es para evitar usar CopyMemory
        Next i
    End If
End Sub
Public Function DecodeEncodeChar(StrChar As String, ByRef Psss As String, PosPass As Long, Optional Encode_Code As tAcciones = Encryptar) As String
Dim CharPass            As String
Dim NewChar             As Byte
Dim i                   As Long
Const cBytes            As Byte = 255
    CharPass = Mid(Psss, PosPass, 1)
    '   //  Buscamos la coherencia
    For i = 0 To cBytes
        If StrChar = Chr(i) Then
            '   //  Calculamos el Nuevo Caracter
            If Encode_Code = Encryptar Then
                NewChar = IIf(Asc(CharPass) + Asc(StrChar) > cBytes, _
                             (Asc(CharPass) + Asc(StrChar)) - cBytes, _
                              Asc(CharPass) + Asc(StrChar))
            Else
                NewChar = IIf(Asc(StrChar) - Asc(CharPass) < 0, _
                              cBytes + (Asc(StrChar) - Asc(CharPass)), _
                              Asc(StrChar) - Asc(CharPass))
            End If
            DecodeEncodeChar = Chr(NewChar)
            Exit For
        End If
    Next i
End Function
 
 

ejemplo de uso:

Agregar en un formuario
1 TextBox
2 CommandButton con matrix 0 y 1 respectivamente

 
Private Sub Command1_Click(Index As Integer)
    Dim AuxData         As String
    AuxData = Text1.Text
    Call DecodeEncodeString(AuxData, "Miguel Angel Ortega Avila", IIf(Index = 0, Encryptar, Desencryptar))
    Text1.Text = AuxData
End Sub
 
 

editpo: Junto Post --->

Para quienes no les sirva bien aquí tienen el codigo implementado en un formulario:

http://infrangelux.sytes.net/Descargas/Crypters/Encode And Decode.rar


Dulces Lunas!¡.

Que nos echamos otro post de discusion?
Deja le cambio nombre...

jajajajaja

Si eso del $ siempre se me pasa es algo que casi no uso por casos sencillos pero es una mala costumbre mia xS

Dulces Lunas!¡.

No se nota hombre

Dulces Lunas !¡

Veo que Cobein se aburre , eso me gusta La ultima vez que se aburria libero el code de recuperar contraseñas en FF

PD: Mi encriptacion mola mas

Era broma, son cosas distintas