Simple Bitwise Text Encryption

Category:

String Manipulation

Type:

Snippets

Difficulty:

Intermediate

Author:

Brian Nicks

Version Compatibility:

More information:

Uses logical operators to change bit values in strings. The results look pretty neat when displayed. Bits 6 and 7 are my favorite.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'none

Code:

Option Explicit
'a simple bit encryption routine.
'accepts a string to be encrypted and an array of integers < 8
'it then takes each character in the string gets it's ascii value
'and flips the bits of the integers provided in the parameter 
'array. use it like this

'dim strString as String
'dim strFinished as String
'strString = "Cobol is not a programming language. It is " & _
'            "punishment for evil deeds in a former life."
'''''to encrypt
'strFinished = BitEncrypt(strString,1,3,7)
'MsgBox strFinished
'''''to decrypt
'strFinished = BitEncrypt(strFinished,1,3,7)
'MsgBox strFinished

Public Function BitEncrypt(ByVal strEnc As String, _
  ParamArray parm() As Variant) As String
        
Dim intCntr     As Integer
Dim intCntr1    As Integer
Dim intAscval   As Integer
Dim strReturn   As String
Dim strChar     As String
    
'get the length of the passed string
'so we can step through each character
'idividually
For intCntr = 1 To Len(strEnc)
        'get individual character
        strChar = Mid(strEnc, intCntr, 1)
        'get the ascii value of the character
        intAscval = Asc(strChar)
        
        'take the character through the encryption
        'loop for each parameter passed in the
        'parameter array
        For intCntr1 = 0 To UBound(parm)
            
            'bits are zero based so we can't change
            'any bits larger than 7
            If parm(intCntr1) > 7 Then Exit For
                
            'check to see if the bit is already set.
            If Not IsBitSet(intAscval, CInt(parm(intCntr1))) Then
                'if the bit is not set turn it on
                intAscval = SetBit(intAscval, _
                    CInt(parm(intCntr1)))
            Else
                'or turn it off
                intAscval = UnSetBit(intAscval, _
                    CInt(parm(intCntr1)))
            End If
        Next
        
        'add the encrypted character to the return string
        strReturn = strReturn & Chr$(intAscval)

Next
    
'return the string
BitEncrypt = strReturn
        
End Function

Function IsBitSet(intAscii As Integer, intBit As Integer) _
   As Boolean

'change the value of the integer passed by
    'turning on the bit passed
    IsBitSet = (intAscii And (2 ^ intBit)) <> 0

End Function

Function SetBit(intAscii As Integer, bit As Integer) As Integer

'test to see if the passed bit
    'is already set
    SetBit = intAscii Or (2 ^ bit)

End Function

Function UnSetBit(intAscii As Integer, bit As Integer) As Integer

'change the value of the integer passed by
    'turning off the bit passed
    UnSetBit = intAscii Xor (2 ^ bit)

End Function