الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

برمجة خوارزميات تشفير vb.net

بدأه حسين احمد طالب في 28 فبراير 2012 · 0 رد · 3,567 مشاهدة · في الرياضيات والخوارزميات
مشاركة: واتساب X فيسبوك تيليجرام
#1

خوارزميات تشفير هي من اهم الوسائل التي تستخدم لتشفير الرسائل المرسلة في الحروب والرسائل التي تحتاج الى سرية في النقل حتى اذا ما اقطتعت في طريقها من قبل شخص غير مرغوب به سوف يؤدي ذالك الى عدم فهمها من قبل الشخص المعترض للرسالة فقط المستلم يستطيع قرائة الرسالة التي له بطريقة مشابه الى طريقة التشفير يقوم بفك تشفير الرسالة المرسلة

01330413146.png

هذه دوال نحتاجها في اغلب عمليات التشفير

دالة ازالة الرموز والفراغات من الرسالة المرسلة

'dfine all the carachter in asci code
Public captail As String = "abcdefghijklmnopqrstuvwxyz"
'remve apace and symbol from meaage
Public Function removespace(ByVal meaage As String) As String
removespace = Nothing
meaage = meaage.ToLower
For i = 0 To Len(meaage) - 1
If (meaage(i) >= "a") And (meaage(i) <= "z") Then
removespace = removespace & meaage(i)
End If
Next
End Function

دالة تحويل كل حرف الى رمزه في الجدول

'convert evry char to his symbol(a=1,b=2)
Public Function captosumbol(ByVal captal12 As String) As String
captosumbol = Nothing
For i = 0 To Len(captal12) - 1
captosumbol = captosumbol & (captail.IndexOf(captal12(i)) + Val(startcencryComboBox1.Text)).ToString
Next
End Function

دالة تحويل كل رمز في الرسالة الى حرف الاصلي

'convert evert symbol to char(1=a,2=b)
Public Function sumboltocap(ByVal captal12 As String) As String
sumboltocap = Nothing
For i = 0 To Len(captal12) - 1
sumboltocap = sumboltocap & captail(Val(captal12(i)) - Val(startcencryComboBox1.Text))
Next
End Function

1. تشفير وفك تشفير بخوارزمية Square

يتم الشفير بهذه الخوارزمية بتوزيع حروف الرسالة الى مصفوفة متساوية الابعاد وتكتب حروف الرسالة صف صف وتقرء في عملية الشفير بشكل حلزوني

مثلا لو كانت لدينا الرسالة التالية (hi hussien ahmmed taleb) ستوزع وتقرء بشكل التالي

21330408370.png

تقرء حسب خط الاحمر اي سيكون النص بعد التشفير (hshtxxxxxbdasuhiimaleenem)

كيف تتم هذه العملية برمجية لو اردنا تكوين برنامج ندخل مسئلة ويشفرها بهذه الطريقة......؟

الطريقة سهلة وجميلة تكون بتكوين عداد خارجي يعد بقدر نصف صفوف المصفوفة وعند كل عدة له نقلب المصفوفة 90 درجة اربع مرات ونقرء الصف الذي يختاره العداد الخارجي عند كل قلبة من اليسار الى اليمين هاملين العناصر التي قرئناها من الصف في عملية سابقة

11330408370.png

41330408370.png

كود لتشفير وفك تشفير cezer,Rot 13

Public Function cezer(ByVal message As String) As String
cezer = Nothing
message = removespace(message)
Dim capzeradd As Integer
For i = 0 To Len(message) - 1
capzeradd = (captail.IndexOf(message(i)) + Val(startcencryComboBox1.Text) + Val(cezerComboBox1.Text))
If capzeradd >= 26 Then
capzeradd = capzeradd Mod 26
End If
cezer = cezer & captail(capzeradd - Val(startcencryComboBox1.Text))
Next
End Function
Public Function cezerInvers(ByVal message As String) As String
cezerInvers = Nothing
message = removespace(message)
Dim capzeradd As Integer
For i = 0 To Len(message) - 1
capzeradd = (captail.IndexOf(message(i)) + Val(startcencryComboBox1.Text) - Val(cezerComboBox1.Text))
If Math.Abs(capzeradd) >= 26 Then
capzeradd = capzeradd Mod 26
End If
If capzeradd < 0 Then
capzeradd = 26 + capzeradd
End If
cezerInvers = cezerInvers & captail(capzeradd - Val(startcencryComboBox1.Text))
Next
End Function

*********************************************************************************

3. تشفير وفك تشفير بخوارزمية at bath

في هذه الخوارزمية نكون جدول يتقسيم الحروف الانكليزية الى صفين ونبدل كل حرف بالحرف المقابل له مثلا a يبدل z والعكس صحيح

51330408370.png

كود فيجوال بيسك تشفير و فك تشفير at bath

Public Function atbath(ByVal message As String) As String
        atbath = Nothing
        message = removespace(message)
        For i = 0 To Len(message) - 1
            atbath = atbath & captail(25 - captail.IndexOf(message(i)))
        Next
    End Function

4. تشفير وفك تشفير بخوارزمية one pad(vernam)

هذه الخوارزمية يعطيك لكل حرف بالرسالة رقم معين نجمعه مع رقم الاصلي للحرف ونعمل له باقي قسمة على 26 لنحصل على حرف جديد

كود فيجوال بيسك تشفير و فك تشفير one pad(vernam)

Public Function onepad_vernam(ByVal message As String) As String
onepad_vernam = Nothing
Try
message = removespace(message)
Dim capzeradd As Integer
For i = 0 To onepaddatgridviewer.RowCount - 1
If Len(onepaddatgridviewer.Item(0, i).Value) > 0 Then
If Len(onepaddatgridviewer.Item(1, i).Value) > 0 Then
capzeradd = captail.IndexOf(onepaddatgridviewer.Item(0, i).Value) + Val(startcencryComboBox1.Text) + onepaddatgridviewer.Item(1, i).Value
If capzeradd >= 26 Then
capzeradd = capzeradd Mod 26
End If
onepad_vernam = onepad_vernam & captail(capzeradd - Val(startcencryComboBox1.Text))
End If
End If
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

5. تشفير وفك تشفير بخوارزمية vigineer

في هذه الخوارزمية يعطيك مفتاح ونكرر هذا المفتاح مع جميع احرف الرسالة ونجمع قيمة المفتاح مع كل حرف يقابله لنحصل على حرف جديد وفي فك التشفير نطرح من المفتاح

6. تشفير وفك تشفير بخوارزمية vigineer

11330408747.png

Public Function vegineer(ByVal message As String, ByVal keys11 As String) As String
vegineer = Nothing
Try

message = removespace(message)
keys11 = removespace(keys11)
Dim capzeradd As Integer
Dim countindex As Integer = 0
For i = 0 To Len(message) - 1
capzeradd = captail.IndexOf(message(i)) + Val(startcencryComboBox1.Text) + captail.IndexOf(keys11(countindex))
If capzeradd >= 26 Then
capzeradd = capzeradd Mod 26
End If

vegineer = vegineer & captail(capzeradd - Val(startcencryComboBox1.Text))
countindex = countindex + 1
If countindex = Len(keys11) Then
countindex = 0
End If
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function



Public Function vegineerinvers(ByVal message As String, ByVal keys11 As String) As String
vegineerinvers = Nothing
Try
message = removespace(message)
keys11 = removespace(keys11)
Dim capzeradd As Integer
Dim countindex As Integer = 0
For i = 0 To Len(message) - 1
capzeradd = captail.IndexOf(message(i)) + Val(startcencryComboBox1.Text) - captail.IndexOf(keys11(countindex))
If Math.Abs(capzeradd) >= 26 Then
capzeradd = capzeradd Mod 26
End If
If capzeradd < 0 Then
capzeradd = 26 + capzeradd
End If
vegineerinvers = vegineerinvers & captail(capzeradd - Val(startcencryComboBox1.Text))
countindex = countindex + 1
If countindex = Len(keys11) Then
countindex = 0
End If
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

6. تشفير وفك تشفير بخوارزمية Affine cipher

هي هذه الخوارزمية في التشفير نستخدم معادلة رياضية

Newkey=m*oldkey+k mod 26

21330408747.png

شفير وفك تشفير بخوارزمية Affine cipher

Public Function affine_cipher(ByVal message As String, ByVal k As Integer, ByVal m As Integer) As String
affine_cipher = Nothing
Try
message = removespace(message)
Dim capzeradd As Integer
For i = 0 To Len(message) - 1
capzeradd = (captail.IndexOf(message(i)) + Val(startcencryComboBox1.Text)) * m + k
If capzeradd >= 26 Then
capzeradd = capzeradd Mod 26
End If
affine_cipher = affine_cipher & captail(capzeradd - Val(startcencryComboBox1.Text))
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

7. تشفير وفك تشفير بخوارزمية cipher Route

هنا نستخدم كلمة مفتاحية لنقسم الرسالة بصفوف بقدر الكلمة المفتاحية ونقرء صف صف حسب اولوية احرف الكلمة المفتاحية

تشفير وفك تشفير بخوارزمية Roue_cipher

31330408747.png

Public Function Roue_cipher(ByVal message As String, ByVal keys As String) As String
Roue_cipher = Nothing
Try
message = removespace(message)
Dim numberrow As Integer = Len(keys)
Dim countm As Integer = 0
Dim numbercol As Integer = Len(message) / numberrow
If numbercol < (Len(message) / numberrow) Then
numbercol = numbercol + 1
End If
Dim arrayrial(numberrow, numbercol) As String
For j = 0 To numbercol - 1
For i = 0 To numberrow - 1

If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If

Next
Next
For k As Integer = 0 To captail.Length - 1
For i = 0 To keys.Length - 1

If keys(i) = captail(k) Then
For j = 0 To numbercol - 1

Roue_cipher = Roue_cipher & arrayrial(i, j)
Next
End If

Next

Next





Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function
Public Function Roue_cipher_invers(ByVal message As String, ByVal keys As String) As String
Roue_cipher_invers = Nothing
Try
message = removespace(message)
Dim numberrow As Integer = Len(keys)
Dim countm As Integer = 0
Dim numbercol As Integer = Len(message) / numberrow
If numbercol < (Len(message) / numberrow) Then
numbercol = numbercol + 1
End If
Dim arrayrial(numberrow, numbercol) As String



'----------------------find after sort
For k As Integer = 0 To captail.Length - 1
For i = 0 To keys.Length - 1

If keys(i) = captail(k) Then
For j = 0 To numbercol - 1

If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If
Next
End If

Next

Next
For j = 0 To numbercol - 1
For i = 0 To numberrow - 1
Roue_cipher_invers = Roue_cipher_invers & arrayrial(i, j)
Next
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

8. تشفير وفك تشفير بخوارزمية vence rial

هنا يعطيك امكانية تقسيم الرسالة بعدد الصفوف التي ترغب بها ويقرء صف صف

41330408747.png

تشفير وفك تشفير بخوارزمية rial_vence

Public Function rial_vence(ByVal message As String, ByVal numberrow As Integer) As String
rial_vence = Nothing
Try
message = removespace(message)
Dim countm As Integer = 0
Dim numbercol As Integer = Len(message) / numberrow
If numbercol < (Len(message) / numberrow) Then
numbercol = numbercol + 1
End If
Dim arrayrial(numberrow, numbercol) As String
For j = 0 To numbercol - 1
For i = 0 To numberrow - 1
If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If
Next
Next
For i = 0 To numberrow - 1
For j = 0 To numbercol - 1
rial_vence = rial_vence & arrayrial(i, j)
Next
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function
Public Function rial_venceinvers(ByVal message As String, ByVal numberrow As Integer) As String
rial_venceinvers = Nothing
Try
message = removespace(message)
Dim countm As Integer = 0
Dim numbercol As Integer = Len(message) / numberrow
If numbercol < (Len(message) / numberrow) Then
numbercol = numbercol + 1
End If
Dim arrayrial(numberrow, numbercol) As String
For i = 0 To numberrow - 1
For j = 0 To numbercol - 1
If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If
Next
Next
For j = 0 To numbercol - 1
For i = 0 To numberrow - 1
ial_venceinvers = rial_venceinvers & arrayrial(i, j)
Next
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

9. تشفير وفك تشفير بخوارزمية coloums_tarnsposition

يقسم الرسالة الى اعمدة بقدر الكلمة المفتاحية ويقرء الاعمدة حسب تسلسل الحرف

51330408747.png

تشفير وفك تشفير بخوارزمية coloums_tarnsposition 

Public Function coloums_tarnsposition(ByVal message As String, ByVal keys As String) As String
coloums_tarnsposition = Nothing
Try
message = removespace(message)
Dim numberrow As Integer = Len(message) / Len(keys)
Dim countm As Integer = 0
Dim numbercol As Integer = Len(keys)
If numberrow < (Len(message) / Len(keys)) Then
numberrow = numberrow + 1
End If
Dim arrayrial(numberrow, numbercol) As String

For i = 0 To numberrow - 1
For j = 0 To numbercol - 1
If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If

Next
Next

For k As Integer = 0 To captail.Length - 1

For j = 0 To keys.Length - 1
If keys(j) = captail(k) Then
For i = 0 To numberrow - 1
coloums_tarnsposition = coloums_tarnsposition & arrayrial(i, j)
Next
End If

Next

Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function
Public Function coloums_tarnsposition_inverse(ByVal message As String, ByVal keys As String) As String
coloums_tarnsposition_inverse = Nothing
Try
message = removespace(message)
Dim numberrow As Integer = Len(message) / Len(keys)
Dim countm As Integer = 0
Dim numbercol As Integer = Len(keys)
If numberrow < (Len(message) / Len(keys)) Then
numberrow = numberrow + 1
End If
Dim arrayrial(numberrow, numbercol) As String
'----------------------find after sort
For k As Integer = 0 To captail.Length - 1
For j = 0 To numbercol - 1
If keys(j) = captail(k) Then
For i = 0 To numberrow - 1
If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If
Next
End If

Next
Next
For i = 0 To numberrow - 1
For j = 0 To numbercol - 1
coloums_tarnsposition_inverse = coloums_tarnsposition_inverse & arrayrial(i, j)
Next
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

10. تشفير وفك تشفير بخوارزمية nichlist

هنا يقرء الاعمدة حسب تسلسل كلمة مفتاحية

تشفير وفك تشفير بخوارزمية nichlist

Public Function nichlist(ByVal message As String, ByVal keys11 As String) As String
nichlist = Nothing
Try
Dim keys() As String = Split(keys11, " ")
message = removespace(message)
Dim numberrow As Integer = Len(message) / keys.Length
Dim countm As Integer = 0
Dim numbercol As Integer = keys.Length
If numberrow < (Len(message) / keys.Length) Then
numberrow = numberrow + 1
End If
Dim arrayrial(numberrow, numbercol) As String

For i = 0 To numberrow - 1
For j = 0 To numbercol - 1
If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If

Next
Next

For k As Integer = 0 To 100

For j = 0 To keys.Length - 1
If keys(j) = k.ToString Then
For i = 0 To numberrow - 1
nichlist = nichlist & arrayrial(i, j)
Next
End If

Next

Next

Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function
Public Function nichlist_inverse(ByVal message As String, ByVal keys11 As String) As String
nichlist_inverse = Nothing
Try
message = removespace(message)
Dim keys() As String = Split(keys11, " ")
Dim numberrow As Integer = Len(message) / keys.Length
Dim countm As Integer = 0
Dim numbercol As Integer = keys.Length
If numberrow < (Len(message) / keys.Length) Then
numberrow = numberrow + 1
End If
Dim arrayrial(numberrow, numbercol) As String

'----------------------find after sort
For k As Integer = 0 To 100
For j = 0 To numbercol - 1
If keys(j) = k.ToString Then
For i = 0 To numberrow - 1
If countm < Len(message) Then
arrayrial(i, j) = message(countm)
countm = countm + 1
Else
arrayrial(i, j) = "x"
End If
Next
End If

Next

Next
For i = 0 To numberrow - 1

For j = 0 To numbercol - 1
nichlist_inverse = nichlist_inverse & arrayrial(i, j)
Next
Next
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "error Enter")
End Try
End Function

برنامج للتشفير وفك التشفير الخاص بدرس

01330408747.png

قمت بتصميم برنامج متكامل يقوم بتشفير وفك تشفير الرسائل بشكل تعليمي وخطوة بخطوة مع الدرس

حمل المثال والمحاضرة من هنا

http://www.mediafire.com/?bo9l1091x46etqd

مدونتي

http://hussienahmmed.blogspot.com/

تم تعديل هذه المشاركة بواسطة حسين احمد طالب في 29 فبراير 2012 في 08:34

------------------

حسين الربيعي

 

مهندس برامجيات من العراق

 

ادرس  في  RIT  في الولايات المتحدة

 

مدونتي

http://hussienahmmed.blogspot.com/

 

قناة اليوتيوب الخاصة بلدورات

https://www.youtube.com/user/alxs1aa

مواضيع مشابهة