A hobby of mine is writing encryption algorithms in Excel VBA. I freel
admit that I am both an amateur cryptographer and VBA programmer.

For those of you that are better programmers than I, can you come u
with a more effecient (read: quicker) way of implementing th
transposition cipher I provide below? (Hat tip to Norman Jones on th
scramble array used below).

To use, create the following:
(1) Userform1
(2) Textbox1 ' this box is used for informational purpose only. I
shows the array used to transpose the plaintext.
(3) Textbox2 ' type your plaintext message into this box
(4) Textbox3 ' Ciphertext is shown in this box
(5) Textbox4 ' Decrypted ciphertext is shown in this box
(6) CommandButton1 ' closes the userform
(7) CommandButton2 ' launches the code

Here is the code (paste into userform1):
_________________________________
Option Base 1
Private Sub CommandButton1_Click()
UserForm1.Hide

End Sub

Private Sub CommandButton2_Click()
Dim arr As Variant, arr2 As Variant
Dim array_count, String_array As String
Dim i As Long, j As Long
Dim swap As String
Dim strOut As String
Dim myarray() As Variant

If Len(UserForm1.TextBox2.Value) = 0 Then
MsgBox ("Enter text.")
Exit Sub
End If

Total_chars = Len(UserForm1.TextBox2.Value)
ReDim myarray(Total_chars)
modulus = 830584
base = 32
'
' Create scramble array with key
'
For q = 1 To Total_chars
tri_graph = "Zen" ' the Key
sub1 = Mid(tri_graph, 1, 1)
sub2 = Mid(tri_graph, 2, 1)
sub3 = Mid(tri_graph, 3, 1)
sub1_tri_graph = (Asc(sub1) + q - base) * alphabet_length ^ 2
sub2_tri_graph = (Asc(sub2) + q - base) * alphabet_length
sub3_tri_graph = (Asc(sub3) + q - base)
tri_sum = sub1_tri_graph + sub2_tri_graph + sub3_tri_graph
V = tri_sum
Mod_form = (V * 737333) - modulus * Int((V * 737333) / modulus)
myarray(q) = Mod_form ' the "raw" scrambled array
Next
'
'
' Sort Scramble
arr = myarray()
arr2 = arr
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If arr(i) arr(j) Then
swap = arr(i)
arr(i) = arr(j)
arr(j) = CLng(swap)
End If
Next j
Next i
'
Dim NewArray() As Variant
ReDim NewArray(UBound(arr))
For i = LBound(arr) To UBound(arr)
NewArray(i) = strOut & Application.Match(arr2(i), arr, 0) ' change
"raw" array into a ranked order array
strOut2 = strOut2 & NewArray(i) & ", "
Next i
TextBox1.Value = strOut2 ' just shows the ranked array, should be 1 t
number of characters in a srambled order
'
'
' ENCRYPT
Char_count = Len(TextBox2.Value)
For n = 1 To Char_count
current_pos = NewArray(n)
New_text = Mid(UserForm1.TextBox2.Value, current_pos, 1)
UserForm1.TextBox3.Value = UserForm1.TextBox3.Value & New_text
Next
'
'
' Decrypt
cipher_count = Len(TextBox3.Value)
order = 0
test_count = 0
For m = 1 To cipher_count
test_count = test_count + 1
For check = 1 To cipher_count
order = order + 1
If NewArray(order) - test_count = 0 Then
UserForm1.TextBox4.Value = UserForm1.TextBox4.Value
Mid(UserForm1.TextBox3.Value, order, 1)
Exit For
End If

Next
order = 0
Next
'UserForm1.TextBox4.Value = Mid(UserForm1.TextBox3.Value
NewArray(order + 4), 1)
End Sub
__________________________
Notes: the "key" -- tri_graph -- is used here as a placeholder. In th
real implementation of this algorithm, one would want a much longer ke
(or in my case, I use it as a sub-step in a more sophisticate
multi-round algorithm). I wrote this implementation in Modulo 94^
(830584). 94, because I am using 94 characters in the alphabet (ASC
Characters 32 through 125). Raised to third power because I wanted
much larger "alphabet" -- every possible combination of 3 character
consisting of Chr(32) through Chr (125). The number 737333 i
relatively prime to modulo 830584 (there are about 1/2 million othe
relative primes that could be used). How it works: The key is used t
create an array with a numner of elements equal to the number o
characters of plaintext. The Array has one-to-one correspondence
because we are dealing in modular arithmetic with a relatively prim
multipler (if you don't know, don't ask...), meaning that the arra
will not contain any two numbers of equal rank. This is important
because the plaint text is transposed based on the ranks of the array
elements. E.g. if plaintext = "Hello", and ranked array = (5,3,4,1,2),
Ciphertext will be: "ollHe" (i.e. if the array came out (5,3,2,2,1) it
would'nt have one-to-one correspondence and we couldn't use it for
encryption).

Finally, a note on security...this is not a secure cipher by itself.
It becomes much stronger if combined with a substitution cipher.


--
jasonsweeney
------------------------------------------------------------------------
jasonsweeney's Profile: http://www.excelforum.com/member.php...fo&userid=5222
View this thread: http://www.excelforum.com/showthread...hreadid=480319

jason,

First thing I would do is add "Option Explicit" at the top of the module
and declare all variables.
Changing all those variants to their proper type could make some difference.
"Mid" also returns a variant unless you ask for a string...Mid$

Jim Cone
San Francisco, USA


"jasonsweeney"

wrote in message
news:jasonsweeney.1xngmd_1130565909.3329@excelforu m-nospam.com
A hobby of mine is writing encryption algorithms in Excel VBA. I freely
admit that I am both an amateur cryptographer and VBA programmer.

For those of you that are better programmers than I, can you come up
with a more effecient (read: quicker) way of implementing the
transposition cipher I provide below? (Hat tip to Norman Jones on the
scramble array used below).

To use, create the following:
(1) Userform1
(2) Textbox1 ' this box is used for informational purpose only. It
shows the array used to transpose the plaintext.
(3) Textbox2 ' type your plaintext message into this box
(4) Textbox3 ' Ciphertext is shown in this box
(5) Textbox4 ' Decrypted ciphertext is shown in this box
(6) CommandButton1 ' closes the userform
(7) CommandButton2 ' launches the code

Here is the code (paste into userform1):
_________________________________
Option Base 1
Private Sub CommandButton1_Click()
UserForm1.Hide

End Sub

Private Sub CommandButton2_Click()
Dim arr As Variant, arr2 As Variant
Dim array_count, String_array As String
Dim i As Long, j As Long
Dim swap As String
Dim strOut As String
Dim myarray() As Variant

If Len(UserForm1.TextBox2.Value) = 0 Then
MsgBox ("Enter text.")
Exit Sub
End If

Total_chars = Len(UserForm1.TextBox2.Value)
ReDim myarray(Total_chars)
modulus = 830584
base = 32
'
' Create scramble array with key
'
For q = 1 To Total_chars
tri_graph = "Zen" ' the Key
sub1 = Mid(tri_graph, 1, 1)
sub2 = Mid(tri_graph, 2, 1)
sub3 = Mid(tri_graph, 3, 1)
sub1_tri_graph = (Asc(sub1) + q - base) * alphabet_length ^ 2
sub2_tri_graph = (Asc(sub2) + q - base) * alphabet_length
sub3_tri_graph = (Asc(sub3) + q - base)
tri_sum = sub1_tri_graph + sub2_tri_graph + sub3_tri_graph
V = tri_sum
Mod_form = (V * 737333) - modulus * Int((V * 737333) / modulus)
myarray(q) = Mod_form ' the "raw" scrambled array
Next
'
'
' Sort Scramble
arr = myarray()
arr2 = arr
For i = LBound(arr) To UBound(arr)
For j = i + 1 To UBound(arr)
If arr(i) arr(j) Then
swap = arr(i)
arr(i) = arr(j)
arr(j) = CLng(swap)
End If
Next j
Next i
'
Dim NewArray() As Variant
ReDim NewArray(UBound(arr))
For i = LBound(arr) To UBound(arr)
NewArray(i) = strOut & Application.Match(arr2(i), arr, 0) ' changes
"raw" array into a ranked order array
strOut2 = strOut2 & NewArray(i) & ", "
Next i
TextBox1.Value = strOut2 ' just shows the ranked array, should be 1 to
number of characters in a srambled order
'
'
' ENCRYPT
Char_count = Len(TextBox2.Value)
For n = 1 To Char_count
current_pos = NewArray(n)
New_text = Mid(UserForm1.TextBox2.Value, current_pos, 1)
UserForm1.TextBox3.Value = UserForm1.TextBox3.Value & New_text
Next
'
'
' Decrypt
cipher_count = Len(TextBox3.Value)
order = 0
test_count = 0
For m = 1 To cipher_count
test_count = test_count + 1
For check = 1 To cipher_count
order = order + 1
If NewArray(order) - test_count = 0 Then
UserForm1.TextBox4.Value = UserForm1.TextBox4.Value &
Mid(UserForm1.TextBox3.Value, order, 1)
Exit For
End If

Next
order = 0
Next
'UserForm1.TextBox4.Value = Mid(UserForm1.TextBox3.Value,
NewArray(order + 4), 1)
End Sub
__________________________
-snip-
--
jasonsweeney