PROGRAMA PARA ENCRIPTAR TEXTO

FORMULARIO

Private Sub Form_Load()

txtDencrypt = ""

txtEncrypt = ""

txtUserKey=””

End Sub

Private Sub cmdEncrypt_Click(Index As Integer)

If txtclave=”” then

MsgBox "Debe Incluir una Clave", vbCritical

txtUserKey.SetFocus

Exit Sub

End If

If optEncrypt(0).Value Then

If txtEncrypt = "" Then

MsgBox "Debe Incluir un Texto a Encriptar", vbCritical

txtEncrypt.SetFocus

Exit Sub

End If

txtDencrypt = EncryptString(txtUserKey, txtEncrypt, VBEncrypt)

Else

If txtDencrypt = "" Then

MsgBox "Debe incluir un Texto a Desencriptar", vbCritical

txtDencrypt.SetFocus

Exit Sub

End If

txtEncrypt = EncryptString(txtUserKey, txtDencrypt, VBDecrypt)

End If

End Sub

Public Sub mnu_abrir_Click()

Dim c

c = ""

CommonDialog1.Filter = "Archivos de texto (*.txt)|*.txt"

CommonDialog1.ShowOpen

If CommonDialog1.FileName <> "" Then

Open CommonDialog1.FileName For Input As #1

Do While Not EOF(1)

c = c + Input(1, #1)

Loop

Close #1

txtDencrypt.Text = Left(c, Len(c) - 2)

End If

CommonDialog1.FileName = ""

End Sub

Public Sub mnu_guardar_Click()

CommonDialog1.Filter = "Archivos de texto (*.txt)|*.txt"

CommonDialog1.ShowSave

If CommonDialog1.FileName <> "" Then

Open CommonDialog1.FileName For Output As #2

Print #2, txtDencrypt.Text

Close #2

Else

End If

End Sub

Private Sub mnu_nuevo_Click()

txtEncrypt.Text = ""

txtDencrypt.Text = ""

End Sub

Private Sub mnu_salir_Click()

End

End Sub

Módulo

Option Explicit

Public Const VBEncrypt = 1, VBDecrypt = 2

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

Dim Temp As Integer

Dim i As Integer

Dim j As Integer

Dim n As Integer

Dim rtn As String

n = Len(UserKey)

ReDim UserKeyASCIIS(1 To n)

For i = 1 To n

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

Next

ReDim TextASCIIS(Len(Text)) As Integer

For i = 1 To Len(Text)

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

Next

'-- Encryption/Decryption

If Action = VBEncrypt 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

rtn = rtn + Chr$(Temp)

Next

ElseIf Action = VBDecrypt 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

EncryptString = rtn

End Function