[RaggiTech]

المثال العملي سيكون مبسطا جدا بحيث فقط ننظم العملية وبذلك سيكون Interface المثال على شكل صندوق ادخال InputBox ونحن نعلم ان شكله غير جيد خاصة اذا استخدمنا الفكرة مع مشروع له واجهة مستخدم جميلة أو حديثة وكذلك سنحفظ المفتاح في ملف نصي بسيط بينما عندما يتم تطبيق هذه الفكرة سيتم حفظ هذا المفتاح في قاعدة البيانات اذا النظام فيه قاعدة بيانات ويتم حفظه في Registry اذا كان النظام بدون قاعدة بيانات وممكن ايضا في Resources (هل تحبون عمل موضوع عن كل طريقة حفظ ومبرراتها؟؟؟؟)

كود :

Public Class Form1
Dim Mask As String = "98765432"
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
If Not PassSecurity Then End
End Sub
Public Function PassSecurity() As Boolean
Dim BaseKey As String = HardCode()
Dim DataKey As String = LoadCode()
Dim Ret As Boolean = False
Dim ViewedKey As String = Masking_XOR(BaseKey)
If DataKey = ViewedKey Then
MsgBox("Pass")
Ret = True
Else
MsgBox("Fail May be:" & vbCrLf & "1. First Time" & vbCrLf & "2. Copyed Program")
Dim Ans As String = InputBox(ViewedKey, "Security")
If Ans = "" Then
MsgBox("No Answer")
Else
If BaseKey = Ans Then
MsgBox("Valid Code" & vbCrLf & "Pass")
Ret = True
' Saving New Code
Dim FileName As String = Application.StartupPath & "\CodeFile.txt"
Dim FileNum As Integer = FreeFile()
FileOpen(FileNum, FileName, OpenMode.Binary)
FilePut(FileNum, Masking_XOR(Ans))
FileClose()
Else
MsgBox("Invalid Code")
End If
End If
End If
Return Ret
End Function
Public Function HardCode() As String
Dim Ret As String
Dim DriveLetter As String = Application.StartupPath.Substring(0, 3)
Dim obj_FSO As Object
Dim obj_Drive As Object
obj_FSO = CreateObject("Scripting.FileSystemObject")
obj_Drive = obj_FSO.GetDrive(DriveLetter)
Dim SerNum As Integer = obj_Drive.SerialNumber
Ret = Hex(SerNum)
obj_FSO = Nothing
obj_Drive = Nothing
Ret = New String("0", 8 - Ret.Length) & Ret
Return Ret
End Function
Public Function LoadCode() As String
Dim FileName As String = Application.StartupPath & "\CodeFile.txt"
Dim FileNum As Integer = FreeFile()
If Dir(FileName) = "" Then
MsgBox("لايوجد ملف")
FileOpen(FileNum, FileName, OpenMode.Binary)
FilePut(FileNum, "00000000")
FileClose()
End If
Dim Code As New String("0", 8)
FileOpen(FileNum, FileName, OpenMode.Binary)
FileGet(FileNum, Code)
FileClose()
Return Code
End Function
Public Function Masking_Not(ByVal Code As String) As String
Dim Ret As String = ""
Dim Num As Integer = Val("&H" & Code)
Num = Not Num
Ret = Hex(Num)
Ret = New String("0", 8 - Ret.Length) & Ret
Return Ret
End Function
Public Function Masking_XOR(ByVal Code As String) As String
Dim Ret As String = ""
Dim Num_1 As Integer = Val("&H" & Code)
Dim Num_2 As Integer = Val("&H" & Mask)
Dim Num_3 As Integer = Num_1 Xor Num_2
Ret = Hex(Num_3)
Ret = New String("0", 8 - Ret.Length) & Ret
Return Ret
End Function
Public Function Masking_EQV(ByVal Code As String) As String
Dim Ret As String = ""
Dim Num_1 As Integer = Val("&H" & Code)
Dim Num_2 As Integer = Val("&H" & Mask)
Dim Num_3 As Integer = (Not Num_1) Xor Num_2
Ret = Hex(Num_3)
Ret = New String("0", 8 - Ret.Length) & Ret
Return Ret
End Function
End Class

طريقة تجربة البرنامج
شغل البرنامج وأجب على الرسائل بموافق وعند عرض ادخل المفتاح المطلوب وسوف يعطيك مفتاح (جرب ان تجيبه بأي شيء ستجده لا يشغل البرنامج) تاخذه الى الالة الحاسبة وتختار Hex في الالة ثم تلصق المفتاح اللي اخذته من البرنامج وتضغط على XOR ثم 98765432 ثم = سيظهر لك ناتج انسخه ولاحظ انه هو رقم القرص والصقه في البرنامج واجب بموافق تكون فتحت الحماية ... جرب شغل البرنامج لثاني مرة او لثالث مرة تجده مفتوحا