eMc2H 10 - Criptografia basica con VB

eZine lover (@eZine)

Published in

eMc2H

· 2 years ago

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 Sub