He buscado por el foro pero no encuentro nada concreto o no he sabido buscar, alguien puede darme unos link's donde se haya tratado este tema, gracias.
http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/269-cifrar-descifrar.htm (http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/269-cifrar-descifrar.htm)
El link no funciona.
Encontre un codigo y esta bueno pero quiero algo que solo devuelta letras y numeros combinados y no caracteres extraños(ÙöÃÅ"ãèÃ) bueno que acepta los caracteres simples del teclado como "$#-*+" por otro lado el codifo que encontre no funciona correctamente si le coloco un password extraño por ejmplo: z4Dfoxecilefape e intento cifra una sola palabra con f o que enpieze con F.
' cifra una cadena de caracteres.
' S = Cadena a cifrar P = Password
Function EncryptStr(ByVal S As String, ByVal P As String) As String
Dim I As Integer, R As String
Dim C1 As Integer, C2 As Integer
R = ""
If Len(P) > 0 Then
For I = 1 To Len(S)
C1 = Asc(Mid(S, I, 1))
If I > Len(P) Then
C2 = Asc(Mid(P, I Mod Len(P) + 1, 1))
Else
C2 = Asc(Mid(P, I, 1))
End If
C1 = C1 + C2 + 64
If C1 > 255 Then C1 = C1 - 256
R = R + Chr(C1)
Next I
Else
R = S
End If
EncryptStr = R
End Function
' descifra una cadena de caracteres.
' S = Cadena a descifrar P = Password
Function UnEncryptStr(ByVal S As String, ByVal P As String) As String
Dim I As Integer, R As String
Dim C1 As Integer, C2 As Integer
R = ""
If Len(P) > 0 Then
For I = 1 To Len(S)
C1 = Asc(Mid(S, I, 1))
If I > Len(P) Then
C2 = Asc(Mid(P, I Mod Len(P) + 1, 1))
Else
C2 = Asc(Mid(P, I, 1))
End If
C1 = C1 - C2 - 64
If Sgn(C1) = -1 Then C1 = 256 + C1
R = R + Chr(C1)
Next I
Else
R = S
End If
UnEncryptStr = R
End Function
Se me olvido solo necesito un codigo para ofuscar y desofuscar palabras mas que nada para proteger el contenido de archivos texto.
usa este quizas te sirva(ojo no lo hice yo)
Option Explicit
Private LCW As Integer 'Length of CodeWord
Private LS2E As Integer 'Length of String to be Encrypted
Private LAM As Integer 'Length of Array Matrix
Private MP As Integer 'Matrix Position
Private Matrix As String 'Starting Matrix
Private mov1 As String 'First Part of Replacement String
Private mov2 As String 'Second Part of Replacement String
Private CodeWord As String 'CodeWord
Private CWL As String 'CodeWord Letter
Private EncryptedString As String 'String to Return for Encrypt or String to UnEncrypt for UnEncrypt
Private EncryptedLetter As String 'Storage Variable for Character just Encrypted
Private strCryptMatrix(97) As String 'Matrix Array
Public Property Let KeyString(sKeyString As String)
CodeWord = sKeyString
End Property
Public Function Encrypt(mstext As String) As String
Dim X As Integer ' Loop Counter
Dim Y As Integer 'Loop Counter
Dim Z As Integer 'Loop Counter
Dim C2E As String 'Character to Encrypt
Dim Str2Encrypt As String 'Text from TextBox
Str2Encrypt = mstext
LS2E = Len(mstext)
LCW = Len(CodeWord)
EncryptedLetter = ""
EncryptedString = ""
Y = 1
For X = 1 To LS2E
C2E = Mid(Str2Encrypt, X, 1)
MP = InStr(1, Matrix, C2E, 0)
CWL = Mid(CodeWord, Y, 1)
For Z = 1 To LAM
If Mid(strCryptMatrix(Z), MP, 1) = CWL Then
EncryptedLetter = Left(strCryptMatrix(Z), 1)
EncryptedString = EncryptedString + EncryptedLetter
Exit For
End If
Next Z
Y = Y + 1
If Y > LCW Then Y = 1
Next X
Encrypt = EncryptedString
End Function
Private Sub Class_Initialize()
Dim W As Integer 'Loop Counter to set up Matrix
Dim X As Integer 'Loop through Matrix
Matrix = "8x3p5BeabcdfghijklmnoqrstuvwyzACDEFGHIJKLMNOPQRSTUVWXYZ 1246790-.#/\!@$<>&*()[]{}';:,?=+~`^|%_"
Matrix = Matrix + Chr(13) 'Add Carriage Return to Matrix
Matrix = Matrix + Chr(10) 'Add Line Feed to Matrix
Matrix = Matrix + Chr(34) 'Add "
' Unique String used to make Matrix - 8x3p5Be
' Unique String can be any combination that has a character only ONCE.
' EACH Letter in the Matrix is Input ONLY once.
W = 1
LAM = Len(Matrix)
strCryptMatrix(1) = Matrix
For X = 2 To LAM ' LAM = Length of Array Matrix
mov1 = Left(strCryptMatrix(W), 1) 'First Character of strCryptMatrix
mov2 = Right(strCryptMatrix(W), (LAM - 1)) 'All but First Character of strCryptMatrix
strCryptMatrix(X) = mov2 + mov1 'Makes up each row of the Array
W = W + 1
Next X
End Sub
Y como se utiliza esto parece que es parte de una clase o de un control de usuario?, ademas solo hay una funcion para cifrar y no para descifrar
te explicare. esos codes lo que hacen es pasar el caracter a ASCII (que es un numero y con los numro se puden hacer muchas operaciones) la funcion para ver el codigo ASCII de un caracter es Asc() y la contraria (ver el caracter de un codigo ASCII) Chr().
Sabiendo esto, un algoritmo lo que hace es recorrer caracter por caracter, el caracter que coje, lo convierte a ASCII y hace una operacion con ese numero, y luego lo pasa de nuevo a carcter. osea que si tenemos el siguiente code:
For i = 1 To Len(Datos)
cifrar = cifrar & Chr(Asc(Mid(Datos, i, 1)) +1)
Next
lo que hacemos es recorrer cada caracter, pasarlo a ASCII, suma 1 al valor ASCII y lo convierte de nuevo a caracter.
Ahora, para descifrar es la operacion contraria:
For i = 1 To Len(Datos)
Descifrar = Descifrar & Chr(Asc(Mid(Datos, i, 1)) -1)
Next
Esta no es la forma de encriptacion mas elaborada :P pero, solo es para que entiendas mas o menos como funciona esto.
Espero hallas entendido.
Saludos.
Bueno el ejemplo: sencillo y practico pero es mejor mid$() = mid$()
http://foro.elhacker.net/programacion_visual_basic/source_encoder_and_decode_algoritmo_simple-t277003.0.html
Hay que usar mas el buscador del foro y GOOGLE!¡ (Alternativas sinónimos y frases parecidas).
Sangriento Infierno Lunar!¡.
11Sep, gracias por la pequeña explicacion y ya veo mas o menos por donde la cosa, siguiendo tu codigo como pondria una contraseña para cifrar y descifrar, estoy probando de varias formas pero no doy en el clavo, slaudos y todos gracias por responder ahora reviso los link que dejan.