Encrypt/Decrypt

[rdcody]

Hey All,

Can someone show me a simple encrypt/decrypt code that only
uses the following characters...

ABCDEFGHIJKLMNOPQRSTUVWXYZ
abcdefghijklmnopqrstuvwxyz
0123456789

I just do not understand how to do it.

Thanks in advance,
Ron

[rdcody]

I'm sorry ...I forgot something.

It needs to use a changeable password.

Thanks

[JCScoobyRS]

That would be Base64. Here is how to encode and decode Base64:

Public Function DecodeBase64String(ByVal str2Decode As String) As String
 
' ******************************************************************************
'
' Synopsis:     Decode a Base 64 string
'
' Parameters:   str2Decode  - The base 64 encoded input string
'
' Return:       decoded string
'
' Description:
' Coerce 4 base 64 encoded bytes into 3 decoded bytes by converting 4, 6 bit
' values (0 to 63) into 3, 8 bit values. Transform the 8 bit value into its
' ascii character equivalent. Stop converting at the end of the input string
' or when the first '=' (equal sign) is encountered.
'
' ******************************************************************************
 
    Dim lPtr            As Long
    Dim iValue          As Integer
    Dim iLen            As Integer
    Dim iCtr            As Integer
    Dim Bits(1 To 4)    As Byte
    Dim strDecode       As String
 
    ' for each 4 character group....
    For lPtr = 1 To Len(str2Decode) Step 4
        iLen = 4
        For iCtr = 0 To 3
            ' retrive the base 64 value, 4 at a time
            iValue = InStr(1, BASE64CHR, Mid$(str2Decode, lPtr + iCtr, 1), vbBinaryCompare)
            Select Case iValue
                ' A~Za~z0~9+/
                Case 1 To 64: Bits(iCtr + 1) = iValue - 1
                ' =
                Case 65
                    iLen = iCtr
                    Exit For
                ' not found
                Case 0: Exit Function
            End Select
        Next
 
        ' convert the 4, 6 bit values into 3, 8 bit values
        Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) \ &H10
        Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) \ &H4
        Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)
 
        ' add the three new characters to the output string
        For iCtr = 1 To iLen - 1
            strDecode = strDecode & Chr$(Bits(iCtr))
        Next
 
    Next
 
    DecodeBase64String = strDecode
 
End Function
Function Encode64(InputStr As String) As String
    Dim State As Integer
    Dim i As Integer
    Dim Base64
    Dim current As Integer
    Dim old As Integer
    Dim first_new As String
    Dim second_new As String
    Dim Output As String
    
    Base64 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
                   "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
                   "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
                   "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", _
                   "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/")
    
    For i = 1 To Len(InputStr)
         State = State + 1
         Select Case State
         Case 1
             current = Asc(Mid(InputStr, i, 1))
             first_new = Base64((Int(current / 4) And &H3F))
             Output = Output & first_new
         Case 2
             current = Asc(Mid(InputStr, i, 1))
             first_new = Base64((((old * 16) And &H30) Or ((Int(current / 16) And &HF))))
             Output = Output & first_new
         Case 3:
             current = Asc(Mid(InputStr, i, 1))
             first_new = Base64((((old * 4) And &H3C) Or ((Int(current / 64) And &H3))))
             second_new = Base64((current And &H3F))
             Output = Output & first_new & second_new
             State = 0
         End Select
         old = current
     Next
     Select Case State
     Case 1
         first_new = Base64(((old * 16) And &H30))
         Output = Output & first_new & "=="
     Case 2
         first_new = Base64(((old * 4) And &H3C))
         Output = Output & first_new & "="
     End Select
     Encode64 = Output
End Function

HTH, Jeremy

[JCScoobyRS]

You also need these at the top of the code:

Option Compare Text
Private pbBase64Byt(0 To 63)    As Byte             ' base 64 encoder byte array
Private Const BASE64CHR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

[rdcody]

Oh well hell...my mind is fried today or something. How would
you use it?

Thanks JC

[rdcody]

I think mavbe I figuered it out.

Is there anyway to put a password key into that?

[JCScoobyRS]

Here is a sample program:


Let me know if it's what you seek, Jeremy

[rdcody]

Hey Thanks JC.

What I meant was is there any way to put a key into the
encryption? You know, an encryption with a password.

[BuggyProgrammer]

base64 isn't an encryption... it is for sending binary files over the internet when the protocol can only use the limited ascii characters (ie newsgroups).

[JCScoobyRS]

I agree it's not "encryption" but it does alter a string and put it into another form, making it harder to see what the actual password and user id is. Although it's not technically encryption, it is used during SMTP AUTH to encode and decode the username and password. Cody, I don't understand what you are asking. It's been a long day. Explain it to me and I'll help. HTH, Jeremy

[rdcody]

Hey JC ... that's OK, what you showed me will work just fine.

Thanks alot for your help, I really appreciate it.

Ron

[JCScoobyRS]

Are you sure? I can help you out I just think that I misunderstood your question. Let me know, Jeremy