Codigo para cifrar string con vb6.0

[hunter18]

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.

[DJ_MAQUINA]

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/269-cifrar-descifrar.htm

[hunter18]

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.

Código [Seleccionar] Expandir


' 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


[hunter18]

Se me olvido solo necesito un codigo para ofuscar y desofuscar palabras mas que nada para proteger el contenido de archivos texto.

[bomba1990]

usa este quizas te sirva(ojo no lo hice yo)

Código (vb) [Seleccionar] Expandir

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

[hunter18]

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

[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:

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir


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.

[BlackZeroX]

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!¡.

[hunter18]

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.