Autor
|
Tema: Codigo para cifrar string con vb6.0 (Leído 10,643 veces)
|
hunter18
Desconectado
Mensajes: 202
|
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.
|
|
« Última modificación: 29 Junio 2010, 03:19 am por hunter18 »
|
En línea
|
|
|
|
|
hunter18
Desconectado
Mensajes: 202
|
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
|
|
|
En línea
|
|
|
|
hunter18
Desconectado
Mensajes: 202
|
Se me olvido solo necesito un codigo para ofuscar y desofuscar palabras mas que nada para proteger el contenido de archivos texto.
|
|
|
En línea
|
|
|
|
bomba1990
|
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
|
|
|
En línea
|
|
|
|
hunter18
Desconectado
Mensajes: 202
|
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
|
|
|
En línea
|
|
|
|
Once
|
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  pero, solo es para que entiendas mas o menos como funciona esto. Espero hallas entendido. Saludos.
|
|
|
En línea
|
|
|
|
|
hunter18
Desconectado
Mensajes: 202
|
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.
|
|
|
En línea
|
|
|
|
|
|