VB.NET – MEMBUAT FORM AKTIVASI - BEJO'S APPLICATIONS

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

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