Playfair cipher: Difference between revisions
Content added Content deleted
(Added Sidef) |
No edit summary |
||
Line 2,186: | Line 2,186: | ||
Decoded: HI DE TH EG OL DI NT HE TR EX ST UM PZ |
Decoded: HI DE TH EG OL DI NT HE TR EX ST UM PZ |
||
</pre> |
</pre> |
||
=={{header|VBA}}== |
|||
<lang vb> |
|||
Option Explicit |
|||
Private Type Adress |
|||
Row As Integer |
|||
Column As Integer |
|||
End Type |
|||
Private myTable() As String |
|||
Sub Main() |
|||
Dim keyw As String, boolQ As Boolean, text As String, test As Long |
|||
Dim res As String |
|||
keyw = InputBox("Enter your keyword : ", "KeyWord", "Playfair example") |
|||
If keyw = "" Then GoTo ErrorHand |
|||
Debug.Print "Enter your keyword : " & keyw |
|||
boolQ = MsgBox("Ignore Q when buiding table y/n : ", vbYesNo) = vbYes |
|||
Debug.Print "Ignore Q when buiding table y/n : " & IIf(boolQ, "Y", "N") |
|||
Debug.Print "" |
|||
Debug.Print "Table : " |
|||
myTable = CreateTable(keyw, boolQ) |
|||
On Error GoTo ErrorHand |
|||
test = UBound(myTable) |
|||
On Error GoTo 0 |
|||
text = InputBox("Enter your text", "Encode", "hide the gold in the TRRE stump") |
|||
If text = "" Then GoTo ErrorHand |
|||
Debug.Print "" |
|||
Debug.Print "Text to encode : " & text |
|||
Debug.Print "-------------------------------------------------" |
|||
res = Encode(text) |
|||
Debug.Print "Encoded text is : " & res |
|||
res = Decode(res) |
|||
Debug.Print "Decoded text is : " & res |
|||
text = InputBox("Enter your text", "Encode", "hide the gold in the TREE stump") |
|||
If text = "" Then GoTo ErrorHand |
|||
Debug.Print "" |
|||
Debug.Print "Text to encode : " & text |
|||
Debug.Print "-------------------------------------------------" |
|||
res = Encode(text) |
|||
Debug.Print "Encoded text is : " & res |
|||
res = Decode(res) |
|||
Debug.Print "Decoded text is : " & res |
|||
Exit Sub |
|||
ErrorHand: |
|||
Debug.Print "error" |
|||
End Sub |
|||
Private Function CreateTable(strKeyword As String, Q As Boolean) As String() |
|||
Dim r As Integer, c As Integer, temp(1 To 5, 1 To 5) As String, t, cpt As Integer |
|||
Dim strT As String, coll As New Collection |
|||
Dim s As String |
|||
strKeyword = UCase(Replace(strKeyword, " ", "")) |
|||
If Q Then |
|||
If InStr(strKeyword, "J") > 0 Then |
|||
Debug.Print "Your keyword isn't available with your choice : Not Q (==> J) !" |
|||
Exit Function |
|||
End If |
|||
Else |
|||
If InStr(strKeyword, "Q") > 0 Then |
|||
Debug.Print "Your keyword isn't available with your choice : Q (==> Not J) !" |
|||
Exit Function |
|||
End If |
|||
End If |
|||
strT = IIf(Not Q, "ABCDEFGHIKLMNOPQRSTUVWXYZ", "ABCDEFGHIJKLMNOPRSTUVWXYZ") |
|||
t = Split(StrConv(strKeyword, vbUnicode), Chr(0)) |
|||
For c = LBound(t) To UBound(t) - 1 |
|||
strT = Replace(strT, t(c), "") |
|||
On Error Resume Next |
|||
coll.Add t(c), t(c) |
|||
On Error GoTo 0 |
|||
Next |
|||
strKeyword = vbNullString |
|||
For c = 1 To coll.Count |
|||
strKeyword = strKeyword & coll(c) |
|||
Next |
|||
t = Split(StrConv(strKeyword & strT, vbUnicode), Chr(0)) |
|||
c = 1: r = 1 |
|||
For cpt = LBound(t) To UBound(t) - 1 |
|||
temp(r, c) = t(cpt) |
|||
s = s & " " & t(cpt) |
|||
c = c + 1 |
|||
If c = 6 Then c = 1: r = r + 1: Debug.Print " " & s: s = "" |
|||
Next |
|||
CreateTable = temp |
|||
End Function |
|||
Private Function Encode(s As String) As String |
|||
Dim i&, t() As String, cpt& |
|||
s = UCase(Replace(s, " ", "")) |
|||
'insert "X" |
|||
For i = 1 To Len(s) - 1 |
|||
If Mid(s, i, 1) = Mid(s, i + 1, 1) Then s = Left(s, i) & "X" & Right(s, Len(s) - i) |
|||
Next |
|||
'Do the pairs |
|||
For i = 1 To Len(s) Step 2 |
|||
ReDim Preserve t(cpt) |
|||
t(cpt) = Mid(s, i, 2) |
|||
cpt = cpt + 1 |
|||
Next i |
|||
If Len(t(UBound(t))) = 1 Then t(UBound(t)) = t(UBound(t)) & "X" |
|||
Debug.Print "[the pairs : " & Join(t, " ") & "]" |
|||
'swap the pairs |
|||
For i = LBound(t) To UBound(t) |
|||
t(i) = SwapPairsEncoding(t(i)) |
|||
Next |
|||
Encode = Join(t, " ") |
|||
End Function |
|||
Private Function SwapPairsEncoding(s As String) As String |
|||
Dim r As Integer, c As Integer, d1 As String, d2 As String |
|||
Dim addD1 As Adress, addD2 As Adress, resD1 As Adress, resD2 As Adress |
|||
d1 = Left(s, 1): d2 = Right(s, 1) |
|||
For r = 1 To 5 |
|||
For c = 1 To 5 |
|||
If d1 = myTable(r, c) Then addD1.Row = r: addD1.Column = c |
|||
If d2 = myTable(r, c) Then addD2.Row = r: addD2.Column = c |
|||
Next |
|||
Next |
|||
Select Case True |
|||
Case addD1.Row = addD2.Row And addD1.Column <> addD2.Column |
|||
'same row, different columns |
|||
resD1.Column = IIf(addD1.Column + 1 = 6, 1, addD1.Column + 1) |
|||
resD2.Column = IIf(addD2.Column + 1 = 6, 1, addD2.Column + 1) |
|||
SwapPairsEncoding = myTable(addD1.Row, resD1.Column) & myTable(addD2.Row, resD2.Column) |
|||
Case addD1.Row <> addD2.Row And addD1.Column = addD2.Column |
|||
'same columns, different rows |
|||
resD1.Row = IIf(addD1.Row + 1 = 6, 1, addD1.Row + 1) |
|||
resD2.Row = IIf(addD2.Row + 1 = 6, 1, addD2.Row + 1) |
|||
SwapPairsEncoding = myTable(resD1.Row, addD1.Column) & myTable(resD2.Row, addD2.Column) |
|||
Case addD1.Row <> addD2.Row And addD1.Column <> addD2.Column |
|||
'different rows, different columns |
|||
resD1.Row = addD1.Row |
|||
resD2.Row = addD2.Row |
|||
resD1.Column = addD2.Column |
|||
resD2.Column = addD1.Column |
|||
SwapPairsEncoding = myTable(resD1.Row, resD1.Column) & myTable(resD2.Row, resD2.Column) |
|||
End Select |
|||
End Function |
|||
Private Function Decode(s As String) As String |
|||
Dim t, i&, j&, e& |
|||
t = Split(s, " ") |
|||
e = UBound(t) - 1 |
|||
'swap the pairs |
|||
For i = LBound(t) To UBound(t) |
|||
t(i) = SwapPairsDecoding(CStr(t(i))) |
|||
Next |
|||
'remove "X" |
|||
For i = LBound(t) To e |
|||
If Right(t(i), 1) = "X" And Left(t(i), 1) = Left(t(i + 1), 1) Then |
|||
t(i) = Left(t(i), 1) & Left(t(i + 1), 1) |
|||
For j = i + 1 To UBound(t) - 1 |
|||
t(j) = Right(t(j), 1) & Left(t(j + 1), 1) |
|||
Next j |
|||
If Right(t(j), 1) = "X" Then |
|||
ReDim Preserve t(j - 1) |
|||
Else |
|||
t(j) = Right(t(j), 1) & "X" |
|||
End If |
|||
ElseIf Left(t(i + 1), 1) = "X" And Right(t(i), 1) = Right(t(i + 1), 1) Then |
|||
For j = i + 1 To UBound(t) - 1 |
|||
t(j) = Right(t(j), 1) & Left(t(j + 1), 1) |
|||
Next j |
|||
If Right(t(j), 1) = "X" Then |
|||
ReDim Preserve t(j - 1) |
|||
Else |
|||
t(j) = Right(t(j), 1) & "X" |
|||
End If |
|||
End If |
|||
Next |
|||
Decode = Join(t, " ") |
|||
End Function |
|||
Private Function SwapPairsDecoding(s As String) As String |
|||
Dim r As Integer, c As Integer, d1 As String, d2 As String, Flag As Boolean |
|||
Dim addD1 As Adress, addD2 As Adress, resD1 As Adress, resD2 As Adress |
|||
d1 = Left(s, 1): d2 = Right(s, 1) |
|||
For r = 1 To 5 |
|||
For c = 1 To 5 |
|||
If d1 = myTable(r, c) Then addD1.Row = r: addD1.Column = c |
|||
If d2 = myTable(r, c) Then addD2.Row = r: addD2.Column = c |
|||
If addD1.Row <> 0 And addD2.Row <> 0 Then Flag = True: Exit For |
|||
Next |
|||
If Flag Then Exit For |
|||
Next |
|||
Select Case True |
|||
Case addD1.Row = addD2.Row And addD1.Column <> addD2.Column |
|||
'same row, different columns |
|||
resD1.Column = IIf(addD1.Column - 1 = 0, 5, addD1.Column - 1) |
|||
resD2.Column = IIf(addD2.Column - 1 = 0, 5, addD2.Column - 1) |
|||
SwapPairsDecoding = myTable(addD1.Row, resD1.Column) & myTable(addD2.Row, resD2.Column) |
|||
Case addD1.Row <> addD2.Row And addD1.Column = addD2.Column |
|||
'same columns, different rows |
|||
resD1.Row = IIf(addD1.Row - 1 = 0, 5, addD1.Row - 1) |
|||
resD2.Row = IIf(addD2.Row - 1 = 0, 5, addD2.Row - 1) |
|||
SwapPairsDecoding = myTable(resD1.Row, addD1.Column) & myTable(resD2.Row, addD2.Column) |
|||
Case addD1.Row <> addD2.Row And addD1.Column <> addD2.Column |
|||
'different rows, different columns |
|||
resD1.Row = addD1.Row |
|||
resD2.Row = addD2.Row |
|||
resD1.Column = addD2.Column |
|||
resD2.Column = addD1.Column |
|||
SwapPairsDecoding = myTable(resD1.Row, resD1.Column) & myTable(resD2.Row, resD2.Column) |
|||
End Select |
|||
End Function</lang> |
|||
{{out}} |
|||
<pre>Enter your keyword : Playfair example |
|||
Ignore Q when buiding table y/n : N |
|||
Table : |
|||
P L A Y F |
|||
I R E X M |
|||
B C D G H |
|||
K N O Q S |
|||
T U V W Z |
|||
Text to encode : hide the gold in the TRRE stump |
|||
------------------------------------------------- |
|||
[the pairs : HI DE TH EG OL DI NT HE TR XR ES TU MP] |
|||
Encoded text is : BM OD ZB XD NA BE KU DM UI ME MO UV IF |
|||
Decoded text is : HI DE TH EG OL DI NT HE TR RE ST UM PX |
|||
Text to encode : hide the gold in the TREE stump |
|||
------------------------------------------------- |
|||
[the pairs : HI DE TH EG OL DI NT HE TR EX ES TU MP] |
|||
Encoded text is : BM OD ZB XD NA BE KU DM UI XM MO UV IF |
|||
Decoded text is : HI DE TH EG OL DI NT HE TR EE ST UM PX</pre> |
|||
=={{header|zkl}}== |
=={{header|zkl}}== |