aiman كتب :اخي الكريم
بالنسبة الى الكود لا توجد مشكلة انما الفيجوال يعطيك رسالة تنبيه بان المتغير لا يحوي قيمة و الدليل ان الكود عمل معك فلو كان يحوي مشكلة كيف سيعمل ؟؟؟
اما بالنسبة الى الأدوات فلا حاجة لها ( نسيت ان احذفها )
.. لكن لمن جيت انقلها لمشروعي شوف وش ظهرلي :confused: مع اني ما غيرت ولا شئ .. اضغط على الصورة للتكبير amgadtamer كتب :قم بالضغط علي add refrence ثم اختيار system.management ثم ok وقم باضافة هذا السطر في اول المشروع
imports system.management
amgadtamer كتب :قم بالضغط علي add refrence ثم اختيار system.management ثم ok وقم باضافة هذا السطر في اول المشروع
imports system.management
Imports System.Management
Module ModReg
Public Function GetComputerCode() As String
On Error Resume Next
Dim Searcher As ManagementObjectSearcher
Dim Encrypt As String = ""
Dim Idp As String = ""
Dim Code As String = ""
Searcher = New ManagementObjectSearcher("Select ProcessorId From Win32_Processor")
For Each Device As ManagementObject In Searcher.Get
For Each Prop As PropertyData In Device.Properties
Idp = (Prop.Value.ToString)
Next
Next
Encrypt = EncryptingData(Idp, 17)
For I As Integer = 0 To Idp.Length - 1
Code += Idp(I) & Encrypt(I)
Next
Return Code
End Function
Public Function GetRegCode(ByVal Code As String) As String
On Error Resume Next
Dim Idp As String = ""
Dim Encrypt As String = ""
Dim UnCode As String = ""
For I As Integer = 0 To Code.Length - 1 Step 2
Idp += Code(I)
Encrypt += Code(I + 1)
Next
For I As Integer = 0 To Idp.Length - 1
UnCode += Obfuscate(Idp)(I) & Obfuscate(Encrypt)(I)
Next
Return ReplaceOem(UnCode)
End Function
Private Function EncryptingData(ByVal DataString As String, ByVal Key As Integer) As String
On Error Resume Next
Dim Ch As Char() = DataString.ToCharArray
Dim sb As New System.Text.StringBuilder
For i As Integer = 0 To Ch.Length - 1
sb.Append(Convert.ToChar(Convert.ToInt64(Ch(i)) + Key))
Next
Return sb.ToString
End Function
Private Function Obfuscate(ByVal origText As String) As String
On Error Resume Next
Dim textBytes As Byte() = System.Text.Encoding.Unicode.GetBytes(origText)
For counter As Integer = 0 To textBytes.Length - 1
If (textBytes(counter) > 31) And (textBytes(counter) < 127) Then
textBytes(counter) += CByte(counter Mod 31 + 1)
If (textBytes(counter) > 126) Then textBytes(counter) -= CByte(95)
End If
Next counter
Return System.Text.Encoding.Unicode.GetChars(textBytes)
End Function
Private Function ReplaceOem(ByVal Str As String) As String
Str = Replace(Str, "`", "0")
Str = Replace(Str, "]", "1")
Str = Replace(Str, "[", "2")
Str = Replace(Str, "'", "3")
Str = Replace(Str, "\", "4")
Str = Replace(Str, ";", "5")
Str = Replace(Str, "/", "6")
Str = Replace(Str, ".", "7")
Str = Replace(Str, ",", "8")
Str = Replace(Str, "}", "9")
Str = Replace(Str, "{", "10")
Str = Replace(Str, "<", "11")
Str = Replace(Str, ">", "12")
Str = Replace(Str, "?", "13")
Str = Replace(Str, "~", "14")
Str = Replace(Str, "=", "15")
Str = Replace(Str, "+", "16")
Str = Replace(Str, "-", "17")
Str = Replace(Str, "_", "18")
Str = Replace(Str, """", "19")
Str = Replace(Str, "*", "20")
Str = Replace(Str, "&", "21")
Str = Replace(Str, "^", "22")
Str = Replace(Str, "%", "23")
Str = Replace(Str, "$", "24")
Str = Replace(Str, "#", "25")
Str = Replace(Str, "@", "26")
Str = Replace(Str, "!", "27")
Return Str
End Function
End ModuleDim Code As String = ModReg.GetRegCode(ModReg.GetComputerCode & "_MyApp")
TextBox1.Text = CodeDim Code As String = ModReg.GetRegCode(ModReg.GetComputerCode & "_MyApp")
If Code <> [color=#ff0000]"كود المشتري"[/color] Then
MsgBox("البرنامج غير مصرح له بالعمل إلا على جهاز واحد")
Application.ExitThread()
Application.Exit()
End IfDim idp As String ' رقم المعالج
Dim idp1 As String ' رقم التسجيل
Dim idp2 As String ' رقم التفعيل
Function Str2Int(ByVal InStrng As Object) As String
Dim StrLn As Integer
Dim Cntr As Integer
Dim NewStr As String
Str2Int = ""
StrLn = Len(InStrng)
If StrLn = 0 Then Exit Function
NewStr = ""
For Cntr = 1 To StrLn
Select Case Mid(InStrng, Cntr, 1)
Case "0" To "z"
NewStr = NewStr & Asc(Mid(InStrng, Cntr, 1))
End Select
Next Cntr
Str2Int = NewStr
End Function
Public Function Obfuscate(ByVal origText As String) As String
Dim textBytes As Byte() = System.Text.Encoding.Unicode.GetBytes(origText)
For counter As Integer = 0 To textBytes.Length - 1
If (textBytes(counter) > 50) And (textBytes(counter) < 300) Then
textBytes(counter) += CByte(counter Mod 31 + 1)
If (textBytes(counter) > 250) Then textBytes(counter) -= CByte(100)
End If
Next counter
Return System.Text.Encoding.Unicode.GetChars(textBytes)
End FunctionImports System.Data
Imports System.Data.OleDb
Imports System.Globalization
Imports System.Threading
Imports System.Resources
Imports System.Reflection
Public Class ser
Dim idp As String ' رقم المعالج
Dim idp1 As String ' رقم التسجيل
Dim idp2 As String ' رقم التفعيل
Private Sub ser_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextBoxX3.Text = Focus()
Dim Searcher As ManagementObjectSearcher
Searcher = New ManagementObjectSearcher("Select ProcessorId From Win32_Processor")
For Each Device As ManagementObject In Searcher.Get
For Each Prop As PropertyData In Device.Properties
idp = (Prop.Value.ToString)
Next
Next
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%
idp = Obfuscate(idp)
idp = Str2Int(idp)
TextBoxX3.Text = idp
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%
idp1 = Obfuscate(idp)
idp1 = Str2Int(idp1)
idp1 = (idp1.Substring(17, 30))
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%
End SubPrivate Sub ButtonX3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonX3.Click
idp2 = idp1
If TextBoxX1.Text = "" Then
MsgBox("hi")
ElseIf TextBoxX4.Text = idp2 Then
LabelX4.ForeColor = Color.Green
LabelX4.Text = "L’activation du produit et correctement . MERCI"
My.Settings.dkm = TextBoxX4.Text
My.Settings.n = TextBoxX1.Text
My.Settings.Save()
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\nn", "num", TextBoxX4.Text)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\RRRR1458", "n", TextBoxX1.Text)
Else
LabelX4.ForeColor = Color.Red
LabelX4.Text = "Echec de l’activation du produit ."
End If
end sub