Copy Link
Add to Bookmark
Report
eMc2H 10 - Criptografia basica con VB
by Owen
Encriptar es el hecho de ocultar alguna informacion mediante un software con opcion a recuperar el mismo dato en la forma original.
Este Programa esta pensado para aquellos q envian mensajes y no quieren q nadie los vea o entienda (principalmente a todos los q envian e-mail) en este encriptador lo principal es la clave o password ya q esta pasa por un proceso por el cual hara q salgan los mismos valores previamente encriptados o para desencriptar.
En esta ezine se distribuye ya el codigo fuente con el programa ejecutable para que practiquen al final del texto anexo mi email para que manden sus criticas y sugerencias
Option Explicit
Private Sub Cipher(ByVal password As String, ByVal from_text As String, to_text As String)
Const MIN_ASC = 32
Const MAX_ASC = 126
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
offset = NumericPassword(password)
Rnd -1
Randomize offset
str_len = Len(from_text)
For i = 1 To str_len
ch = Asc(Mid$(from_text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch + offset) Mod NUM_ASC)
ch = ch + MIN_ASC
to_text = to_text & Chr$(ch)
End If
Next i
End Sub
Private Sub Decipher(ByVal password As String, ByVal from_text As String, to_text As String)
Const MIN_ASC = 32
Const MAX_ASC = 126
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
offset = NumericPassword(password)
Rnd -1
Randomize offset
str_len = Len(from_text)
For i = 1 To str_len
ch = Asc(Mid$(from_text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch + NUM_ASC
ch = ch + MIN_ASC
to_text = to_text & Chr$(ch)
End If
Next i
End Sub
Private Function NumericPassword(ByVal password As String) As Long
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
str_len = Len(password)
For i = 1 To str_len
ch = Asc(Mid$(password, i, 1))
value = value Xor (ch * 2 ^ shift1)
value = value Xor (ch * 2 ^ shift2)
shift1 = (shift1 + 7) Mod 19
shift2 = (shift2 + 13) Mod 23
Next i
NumericPassword = value
End Function
Private Sub cmdexp_Click()
Dim cipher_text As String
Cipher txtPassword.Text, txtprincipal.Text, cipher_text
txtsecundario.Text = cipher_text
End Sub
Private Sub cmdimp_Click()
Dim plain_text As String
Decipher txtPassword.Text, txtsecundario.Text, plain_text
txtprincipal.Text = plain_text
End Sub
Private Sub cmdowen_Click()
Dim cargar As String
Dim path As String
Dim archivo As Integer
Dim tamarchivo As Integer
On Local Error Resume Next
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then Exit Sub
path = CommonDialog1.FileName
If path = "*.txt" Then
MsgBox "No se a cargado ningun archivo", vbCritical, "Encripter"
Else
archivo = FreeFile
Open path For Input As archivo
tamarchivo = LOF(archivo)
cargar = Input$(tamarchivo, archivo)
txtsecundario = cargar
Close archivo
End If
End Sub
Private Sub cmdnew_Click()
txtprincipal = ""
txtsecundario = ""
cmdexp.Enabled = False
cmdimp.Enabled = False
txtPassword = ""
End Sub
Private Sub cmdguardar_Click()
Dim cargar As String
Dim archivo As Integer
Dim tamarchivo As Long
Dim path As String
archivo = FreeFile
path = Left$(Now, 2)
path = path & "-" & Mid$(Now, 4, 2)
path = path & "-" & Mid$(Now, 7, 4)
path = path & " Hora " & Mid$(Now, 12, 2)
path = path & " Minuto " & Mid$(Now, 15, 2)
path = path & " Segundo " & Mid$(Now, 18, 2)
path = path & " " & Mid$(Now, 21, 1)
path = path & Mid$(Now, 23, 1)
path = App.path & "\encript-" & path & ".owen"
Open path For Output As archivo
cargar = txtsecundario
Print #archivo, cargar
Close archivo
MsgBox "Archivo " & path & " se a guardado con exito", vbOKOnly, "Encrypter"
txtsecundario = ""
cmdexp.Enabled = False
cmdimp.Enabled = False
txtPassword = ""
End Sub
Private Sub cmdexit_Click()
End
End Sub
Private Sub cmdtxt_Click()
Dim cargar As String
Dim path As String
Dim archivo As Integer
Dim tamarchivo As Long
CommonDialog2.ShowOpen
If CommonDialog2.FileName = "" Then Exit Sub
path = CommonDialog2.FileName
If path = "*.txt" Then
MsgBox "No se a cargado ningun archivo", vbCritical, "Encripter"
Else
archivo = FreeFile
Open path For Input As archivo
tamarchivo = LOF(archivo)
cargar = Input$(tamarchivo, archivo)
txtprincipal = cargar
Close archivo
End If
End Sub
Private Sub Form_Load()
End Sub
Private Sub txtPassword_Change()
If Len(txtPassword.Text) > 0 Then
cmdexp.Enabled = True
cmdimp.Enabled = True
Else
cmdexp.Enabled = False
cmdimp.Enabled = False
End If
End SubBY Owen
owen@emc2h.com
