كود PHP:
Option Explicit
Public UndoTemp As String
Private numConv(10) As Byte
Private Plain As Variant
Private Code(28) As String
Private Square(36) As String
Private SquareCode(5) As String
Private Row() As Integer
Private PlaySquare As String
Public Function EncodePlayFair(ByVal PlainIn As String, ByVal key As String)
Dim i As Long
Dim P1 As String
Dim P2 As String
Dim Bpos As Long
Dim tmpText As String
PlainIn = TrimText(PlainIn, True, False, False, False)
If PlainIn = "" Then Exit Function
Bpos = 1
Do
If Mid(PlainIn, Bpos, 1) = "J" Then Mid(PlainIn, Bpos, 1) = "I"
If Mid(PlainIn, Bpos + 1, 1) = "J" Then Mid(PlainIn, Bpos + 1, 1) = "I"
If Mid(PlainIn, Bpos, 1) <> Mid(PlainIn, Bpos + 1, 1) Then
Bpos = Bpos + 2
Else
PlainIn = Left(PlainIn, Bpos) & "X" & Mid(PlainIn, Bpos + 1)
Bpos = Bpos + 2
End If
Loop While Bpos < Len(PlainIn)
If Len(PlainIn) Mod 2 <> 0 Then PlainIn = PlainIn & "X"
key = TrimText(key, True, False, False, False)
If Len(key) < 2 Then
MsgBox "Key size too small", vbCritical
Exit Function
End If
If InitPlayFair(key) <> 0 Then Exit Function
For i = 1 To Len(PlainIn) Step 2
P1 = Mid(PlainIn, i, 1)
P2 = Mid(PlainIn, i + 1, 1)
EncodePlayFair = EncodePlayFair & EncodeDigram(P1, P2)
Next
End Function
Public Function TrimText(TextIn As String, Letters As Boolean, Numbers As Boolean, Spaces As Boolean, Points As Boolean)
Dim i As Long
Dim tmp As Byte
For i = 1 To Len(TextIn)
tmp = Asc(UCase(Mid(TextIn, i, 1)))
If Letters = True And (tmp > 64 And tmp < 123) Then
TrimText = TrimText & Chr(tmp)
ElseIf Numbers = True And (tmp > 47 And tmp < 58) Then
TrimText = TrimText & Chr(tmp)
ElseIf Spaces = True And tmp = 32 Then
TrimText = TrimText & Chr(tmp)
ElseIf Points = True And tmp = 46 Then
TrimText = TrimText & Chr(tmp)
End If
Next
End Function
Public Function InitPlayFair(ByVal key As String) As Integer
Dim i As Integer
Dim SQ As String
PlaySquare = ""
For i = 1 To Len(key)
SQ = Mid(key, i, 1)
If InStr(1, PlaySquare, SQ) = 0 And SQ <> "J" Then PlaySquare = PlaySquare & SQ
Next
For i = 1 To 26
SQ = Chr(i + 64)
If InStr(1, PlaySquare, SQ) = 0 And SQ <> "J" Then PlaySquare = PlaySquare & SQ
Next
End Function
Private Function EncodeDigram(ByVal P1 As String, ByVal P2 As String) As String
Dim X1 As Integer
Dim Y1 As Integer
Dim X2 As Integer
Dim Y2 As Integer
Dim tmpX As Integer
Dim tmpY As Integer
Call GetXY(P1, X1, Y1)
Call GetXY(P2, X2, Y2)
If X1 = X2 Then
Y1 = Y1 + 1: If Y1 > 4 Then Y1 = Y1 - 5
Y2 = Y2 + 1: If Y2 > 4 Then Y2 = Y2 - 5
ElseIf Y1 = Y2 Then
X1 = X1 + 1: If X1 > 4 Then X1 = X1 - 5
X2 = X2 + 1: If X2 > 4 Then X2 = X2 - 5
Else
tmpX = X1
tmpY = Y1
X1 = X2
X2 = tmpX
End If
P1 = GetXYchar(X1, Y1)
P2 = GetXYchar(X2, Y2)
EncodeDigram = P1 & P2
End Function
Private Function GetXY(Pchar As String, X As Integer, Y As Integer)
Dim PosP As Integer
PosP = InStr(1, PlaySquare, Pchar) - 1
Y = Int(PosP / 5)
X = PosP - (Y * 5)
End Function
Private Function GetXYchar(X As Integer, Y As Integer)
GetXYchar = Mid(PlaySquare, (Y * 5) + X + 1, 1)
End Function
Public Function TestKey(aKey As Integer, keyNumbers As Boolean, keySpace As Boolean, keyPoint As Boolean) As Integer
If aKey > 64 And aKey < 91 Then
TestKey = aKey
ElseIf aKey > 96 And aKey < 123 Then
TestKey = aKey - 32
ElseIf (aKey > 47 And aKey < 58) And keyNumbers = True Then
TestKey = aKey
ElseIf aKey = 32 And keySpace = True Then
TestKey = aKey
ElseIf aKey = 46 And keyPoint = True Then
TestKey = aKey
ElseIf aKey < 32 Then
TestKey = aKey
Else
TestKey = 0
End If
End Function
Private Sub text1_KeyPress(KeyAscii As Integer)
KeyAscii = TestKey(KeyAscii, False, True, False)
If KeyAscii = Asc("J") Then KeyAscii = Asc("I")
End Sub
هذا الكود لدي في وحدة نمطية خاصة بالتشفير التقليدي و بعد ان اكمل دورة التشفير سأقوم بنشرها كاملة
التشفير الثنائي الابدالي (Digraph Substitution Cipher)وبرمجة شفرة playfair
رد مع اقتباس
المشاركة الأصلية كتبت بواسطة أغرد بهمس
