Option Explicit

'//Define os parametros para as ações em EncryptString

Public Const ENCRYPT = 1, DECRYPT = 2

Public Function EncryptString(UserKey As String, Text As String, Action As Single) As String

    'define as variaveis usadas

    Dim UserKeyX As String

    Dim Temp     As Integer

    Dim Times    As Integer

    Dim i        As Integer

    Dim j        As Integer

    Dim n        As Integer

    Dim rtn      As String

    '//Obtem os caracteres da chave do usuário

    'define o comprimento da chave do usuario usada na criptografia

    n = Len(UserKey)

    'redimensiona o array para o tamanho definido

    ReDim userKeyASCIIS(1 To n)

    'preenche o array com caracteres asc

    Debug.Print UserKey; "=> ";

    For i = 1 To n

        userKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))

        Debug.Print userKeyASCIIS(i); " ";

    Next

    '//redimensiona o array com o tamanho do texto

    'obtem o caractere de texto

    ReDim TEXTAsciis(Len(Text)) As Integer

    'preenche o array com caracteres asc

    Debug.Print

    Debug.Print Text; " => ";

    For i = 1 To Len(Text)

        TEXTAsciis(i) = Asc(Mid$(Text, i, 1))

        Debug.Print TEXTAsciis(i); " ";

    Next

    '//cifra/decifra

    Debug.Print

    Debug.Print "Criptografando"

    If Action = ENCRYPT Then

       For i = 1 To Len(Text)

           j = IIf(j + 1 >= n, 1, j + 1)

           Temp = TEXTAsciis(i) + userKeyASCIIS(j)

           If Temp > 255 Then

              Temp = Temp - 255

           End If

           Debug.Print Temp; " ";

           rtn = rtn + Chr$(Temp)

           Debug.Print rtn

       Next

    ElseIf Action = DECRYPT Then

       For i = 1 To Len(Text)

           j = IIf(j + 1 >= n, 1, j + 1)

           Temp = TEXTAsciis(i) - userKeyASCIIS(j)

           If Temp < 0 Then

              Temp = Temp + 255

           End If

           rtn = rtn + Chr$(Temp)

       Next

    End If

    '//Retorna o texto

    EncryptString = rtn

End Function

Private Sub cmdCripto_Click()

  '//Codifica

  txtCripto.Text = ""

  txtCripto.Text = EncryptString("KEY", txtOrigem.Text, ENCRYPT)

End Sub

Private Sub cmdDeCripto_Click()

  '//DeCodifica

  txtDeCripto.Text = ""

  txtDeCripto.Text = EncryptString("KEY", txtCripto.Text, DECRYPT)

End Sub

Private Sub cmdSair_Click()

  Me.Close

End Sub

Private Sub Command1_Click()

   txtOrigem.Text = ""

  txtCripto.Text = ""

  txtDeCripto.Text = ""

End Sub

Option Explicit

Dim chavealeatoria As String

Dim chave As String

'--------------------------------------------------

' Retorna uma string randomica de caracteres ASCII

'--------------------------------------------------

Public Function caractereAleatorio() As String

    Dim Char    As String

    Dim RndStr  As String

    Dim n       As Integer

    Randomize Timer

    Do

       Char = Chr$(Int(Rnd * 256))

       If InStr(RndStr, Char) = 0 Then

          n = n + 1

          RndStr = RndStr + Char

       End If

    Loop Until n = 256

    caractereAleatorio = RndStr

End Function

Public Function SegredoSeguro(Text As String, SStr As String, EStr As String) As String

    Dim i   As Integer

    Dim rtn As String

    For i = 1 To Len(Text)

        rtn = rtn + Mid$(EStr, InStr(SStr, Mid$(Text, i, 1)), 1)

    Next

    SegredoSeguro = rtn

End Function

Private Sub cmdCifrar_Click()

Dim i As Integer

chavealeatoria = caractereAleatorio()

For i = 0 To 255

    chave = chave + Chr$(i)

Next

'//Codifica

txtCifrado.Text = SegredoSeguro(txtOrigem.Text, chave, chavealeatoria)

End Sub

Private Sub cmdDecifrar_Click()

'//Decodifica

txtDecifrado.Text = SegredoSeguro(txtCifrado.Text, chavealeatoria, chave)

End Sub