Tutorial
kali ini akan menjelaskan bagaimana membuat contoh form aktivasi, yaitu form yang
berfungsi untuk melakukan aktivasi software aplikasi yang kita buat. Dimana biasanya dalam form terdapat dua bagian penting yaitu Serial Number dan Activation Key. Serial Number akan unik disetiap komputer, sehingga dibutuhkan Activation Key yang unik pula.
Untuk mendapatkan Activation Key bisa gunakan tombol Generate, namun jangan lupa untuk menghapus/men-disabled tombol Generate agar tidak bisa diakses oleh pengguna software yang kita buat.
- Silahkan desain form seperti gambar di bawah ini, dan buat property name nya seperti pada gambar.
Copy Kode Program ini di dalam jendela kode ACTIVATION_FORM
Imports Microsoft.Win32
Public Class ACTIVATION_FORM
Private Sub ACTIVATION_FORM_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim
serial As Long
Dim
sm As New SecurityManager
Dim
temp As String
Dim
pjg As Integer
Dim
newSerial As String = ""
serial = sm.GetSerial
temp = serial
pjg = temp.Length
For
i As Integer = 1 To pjg
Dim
a As String
Dim
b As Integer
a = Mid(temp, i, 1)
b = Asc(a)
newSerial = newSerial & a &
b Mod 2
Next
serialTextBox.Text = newSerial
checkLicense()
Dim
kg As New KeyGenerator
Dim
key As String = kg.GenerateKey(serialTextBox.Text)
If
activationKeyTextBox.Text <> key Then
statusLabel.ForeColor = Color.Red
statusLabel.Text = "Not Activated/invalid
key"
Button1.Enabled = True
Else
statusLabel.ForeColor = Color.DarkGreen
statusLabel.Text = "Activated"
Button1.Enabled = False
End
If
End
Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Me.Close()
End
Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
'Dim serial As Long
'If Not Long.TryParse(serialTextBox.Text, serial) Then
'MessageBox.Show("Inavlid serial number")
'Exit Sub
'End If
Dim
kg As New KeyGenerator
Dim
key As String =
kg.GenerateKey(serialTextBox.Text)
activationKeyTextBox.Text = key
End
Sub
Sub
checkLicense()
Dim
kg As New KeyGenerator
Dim
key As String =
kg.GenerateKey(serialTextBox.Text)
If
System.IO.File.Exists(bejoLicenseFile) Then
bejoWriteSettings(bejoLicenseFile, "LICENSE", "serial", serialTextBox.Text)
activationKeyTextBox.Text =
bejoReadSettings(bejoLicenseFile, "LICENSE", "activation_key", "")
Else
bejoWriteSettings(bejoLicenseFile, "LICENSE", "serial", serialTextBox.Text)
activationKeyTextBox.Text = ""
End
If
End
Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim
kg As New KeyGenerator
Dim
key As String =
kg.GenerateKey(serialTextBox.Text)
If
activationKeyTextBox.Text <> key Then
statusLabel.ForeColor = Color.Red
statusLabel.Text = "Not Activated/invalid
key"
MsgBox("Invalid activation
key!", vbExclamation)
Else
bejoWriteSettings(bejoLicenseFile, "LICENSE", "activation_key", activationKeyTextBox.Text)
statusLabel.ForeColor = Color.DarkGreen
statusLabel.Text = "Activated"
MsgBox("Successfull
Activated!",
vbInformation)
End
If
End
Sub
End Class
Tambahkan Module1 pada project dan copy
source code berikut :
Module Module1
Public bejoDirectory As String = My.Application.Info.DirectoryPath
Public bejoLicenseFile As String = bejoDirectory & "\license.ini"
Private Declare Unicode Function GetPrivateProfileString Lib "kernel32" _
Alias
"GetPrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal
lpKeyName As String, ByVal lpDefault As String, _
ByVal
lpReturnedString As String, ByVal nSize As Int32, _
ByVal
lpFileName As String) As Int32
Private Declare Unicode Function WritePrivateProfileString Lib "kernel32" _
Alias
"WritePrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal
lpKeyName As String, ByVal lpString As String, _
ByVal
lpFileName As String) As Int32
Public Sub bejoWriteSettings(ByVal iniFileName As String, ByVal Section As String, ByVal ParamName As String, ByVal ParamVal As String)
Dim
Result As Integer =
WritePrivateProfileString(Section, ParamName, ParamVal, iniFileName)
End
Sub
Public Function bejoReadSettings(ByVal IniFileName As String, ByVal Section As String, ByVal ParamName As String, ByVal ParamDefault As String) As String
Dim
ParamVal As String = Space$(1024)
Dim
LenParamVal As Long =
GetPrivateProfileString(Section, ParamName, ParamDefault, ParamVal,
Len(ParamVal), IniFileName)
bejoReadSettings = Left$(ParamVal,
LenParamVal)
End
Function
End Module
Pada menu Project > Add
References (beri tick pada System.Management)
Tambahkan object Class pada project
simpan dengan nama KeyGenerator.vb, lalu copy code berikut :
Public Class KeyGenerator
Public Function GenerateKey(ByVal serial As String) As String
Dim
x As String = serial
Dim
temp As String = x * x / (x / 2) + x /
193686
Dim
a As String = ""
For
i As Integer = 0 To temp.Length - 1
Dim
s As Char = temp.Substring(i, 1)
If
s = "," Or s = "." Then
a = a & Asc(".")
Else
a = a &
Asc(temp.Substring(i, 1))
End
If
Next
Dim
b As String = a.Substring(0, 5) & "-" & a.Substring(5, 5)
& "-" & a.Substring(10, 5)
& "-" & a.Substring(15, 5)
& "-" & a.Substring(20, 5)
Return b
End
Function
End Class
Tambahkan object Class pada
project simpan dengan nama SecurityManager.vb, lalu copy code berikut :
Imports System.Management
Public Class SecurityManager
Public Function GetSerial() As Long
Dim
mc As New ManagementClass("Win32_NetworkAdapterConfiguration")
Dim
mac As String = ""
Dim
moc As ManagementObjectCollection = mc.GetInstances
For
Each mo As ManagementObject In moc
If
mo.Item("IPEnabled") Then
mac = mo.Item("MacAddress").ToString
End
If
Next
mc.Dispose()
Dim
sum As Long = 0
Dim
index As Integer = 1
For
Each ch As Char In mac
If
Char.IsDigit(ch) Then
sum += sum + Integer.Parse(ch) * (index * 2)
ElseIf Char.IsLetter(ch) Then
Select Case ch.ToString.ToUpper
Case "A"
sum += sum + 10 *
(index * 2)
Case "B"
sum += sum + 11 *
(index * 2)
Case "C"
sum += sum + 12 *
(index * 2)
Case "D"
sum += sum + 13 * (index * 2)
Case "E"
sum += sum + 14 *
(index * 2)
Case "F"
sum += sum + 15 *
(index * 2)
End Select
End
If
index += 1
Next
Return sum
End
Function
Public Function CheckKey(ByVal key As Long) As Boolean
Dim
x As Long = GetSerial()
Dim
y As Long = x * x + 53 / x + 113 * (x
/ 4)
Return y = key
End
Function
End Class
Yang mau download project nya dan papernya download di bawah ini :
