Membuat aktivasi dongle bagian 1 - Simple think

Apa yang ada dipikiran Anda ketika diminta untuk membuat aktivasi menggunakan dongle ? Wahhh susah, wahhh dongle alat apaan tuh, wahhh perlu pesan khusus ke pabrik G, wahhhh harus riset lagi nih, dan wahhhh2x lainnya.

Tapi sebenarnya kalo kita cermati lagi aktivasi dengan dongle lebih sederhana bila dibandingkan dengan aktivasi klasik seperti memasukkan serial number, yaaa minimal menghemat 1 form dan selain itu kelihatan juga lebih wahhhh .

Alat yang digunakan pun enggak perlu yang canggih2x cukup dengan flash disk yang paling murah yang bisa kita dapatkan.

Pada artikel bagian 1 ini kita akan membuat tool sederhana untuk menandai flash disk yang akan dijadikan dongle dan bagaimana memvalidasi flash disk donglenya valid/tidak.

Dan tool ini juga bisa digunakan untuk menandai beberapa flash disk sekaligus, berikut adalah proses sederhana yang dilakukan oleh tool ini.

1. Menampilkan drive (khusus flash disk) dan mengambil serial numbernya
2. Membuat file donglekey yang disimpan di flash disk dan isinya adalah serial number dari flash disk itu sendiri yang sudah dienkripsi, misal dengan enkripsi MD5. File donglekey inilah yang kita butuhkan untuk melakukan validasi flash disk dongle.
3. Menyembunyikan file donglekey menggunakan perintah attrib +s +h

Contoh source code :

Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const SYNCHRONIZE       As Long = &H100000
Private Const INFINITE          As Long = &HFFFF

Private Const SECURITY_CODE     As String = "-eB03DVVsA5RFyvKh" 'ini bisa diganti

Private Sub writeDongleFile(ByVal fileName As String, ByVal key As String)
    Dim fso As Scripting.FileSystemObject
    Dim ts  As Scripting.TextStream

    Set fso = New Scripting.FileSystemObject
    Set ts = fso.OpenTextFile(fileName, ForWriting, True)
    ts.Write key & vbCrLf
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
End Sub

Private Function fileExists(ByVal namaFile As String) As Boolean
    Dim fso As Scripting.FileSystemObject

    On Error GoTo errHandle

    If Not (Len(namaFile) > 0) Then fileExists = False: Exit Function

    Set fso = New Scripting.FileSystemObject
    fileExists = fso.fileExists(namaFile)
    Set fso = Nothing

    Exit Function
errHandle:
    fileExists = False
End Function

Private Function generateKeyByMD5(ByVal serialNumber As String) As String
    Dim objMD5  As clsMD5

    Set objMD5 = New clsMD5
    generateKeyByMD5 = objMD5.CalculateMD5(serialNumber)
    Set objMD5 = Nothing
End Function

Private Sub loadDrive(ByVal lst As ListBox)
    Dim lDs             As Long
    Dim cnt             As Long
    Dim serial          As Long

    Dim strLabel        As String
    Dim fSName          As String
    Dim formatHex       As String
    Dim driveName       As String
    Dim serialNumber    As String
    Dim generateKey     As String
    Dim dongleFile      As String
    Dim cmd             As String

    Dim shellX          As Long
    Dim lPid            As Long
    Dim lHnd            As Long
    Dim lRet            As Long

    'get the available drives
    lDs = GetLogicalDrives
    lst.Clear

    For cnt = 0 To 25
        If (lDs And 2 ^ cnt) <> 0 Then
            driveName = Chr$(65 + cnt) & ":\"

            'Drive Type :
            '***************
            '2 = Removable/flash disk
            '3 = Drive Fixed
            '4 = Remote
            '5 = Cd-Rom
            '6 = Ram disk

            If GetDriveType(driveName) = 2 Then 'hanya flash disk yang kita proses
                dongleFile = driveName & "donglekey"

                If fileExists(dongleFile) Then 'sudah ada file dongle
                    'tampilkan file donglekey sebelumnya
                    'kalo tidak akan terjadi error waktu menjalankan perintah kill
                    cmd = "attrib -s -h " & dongleFile

                    shellX = Shell(cmd, vbHide)
                    lPid = shellX
                    If lPid <> 0 Then
                        lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
                        If lHnd <> 0 Then
                            lRet = WaitForSingleObject(lHnd, INFINITE)
                            CloseHandle (lHnd)
                        End If
                    End If

                    'hapus file dongle sebelumnya
                    'kalo tidak akan terjadi error waktu menulis ulang file dongle
                    'kenapa error,karena file dongle disembunyikan dg attribut +s -> dianggap file system
                    Kill dongleFile
                End If

                strLabel = String$(255, Chr$(0))
                GetVolumeInformation driveName, strLabel, 255, serial, 0, 0, fSName, 255
                strLabel = Left$(strLabel, InStr(1, strLabel, Chr$(0)) - 1)

                GetVolumeInformation driveName, vbNullString, 255, serial, 0, 0, vbNullString, 255

                formatHex = Format(Hex(serial), "00000000")
                serialNumber = Left(formatHex, 4) & "-" & Right(formatHex, 4) 'serial number - plain text
                generateKey = generateKeyByMD5(serialNumber & SECURITY_CODE) 'serial number + security code yang sudah dienkripsi

                Call writeDongleFile(dongleFile, generateKey) 'tulis file dongle ke flash disk
                DoEvents
                Call Shell("attrib +s +h " & dongleFile) 'sembunyikan file dongle

                lst.AddItem strLabel & "(" & Chr$(65 + cnt) & ":" & ") -> Serial Number : " & serialNumber & " -> Generate Key : " & generateKey
            End If
        End If
    Next cnt
    If Not (lst.ListCount > 0) Then lst.AddItem ">> Belom ada flash disk yang di coloxin <<"
End Sub

Private Sub cmdCreateDongleKey_Click()
    Call loadDrive(lstDrive)
End Sub

Contoh sederhana tool dongle

Dan berikut adalah contoh kode untuk memvalidasi flash disk dongle :

Private Function dongleKeyFile(ByVal fileName As String) As String
    Dim fso As Scripting.FileSystemObject
    Dim ts  As Scripting.TextStream
    Dim tmp As String

    On Error GoTo errHandle

    If fileExists(fileName) Then
        Set fso = New Scripting.FileSystemObject
        Set ts = fso.OpenTextFile(fileName, ForReading, False)
        Do While Not ts.AtEndOfStream
            tmp = ts.ReadLine
            If Len(tmp) > 0 Then Exit Do
        Loop
        ts.Close
        Set ts = Nothing
        Set fso = Nothing
    End If

    dongleKeyFile = tmp

    Exit Function
errHandle:
    dongleKeyFile = ""
End Function

Private Function isValidDongle() As Boolean
    Dim lDs             As Long
    Dim cnt             As Long
    Dim serial          As Long

    Dim strLabel        As String
    Dim fSName          As String
    Dim formatHex       As String
    Dim driveName       As String
    Dim serialNumber    As String
    Dim generateKey     As String
    Dim dongleFile      As String

    lDs = GetLogicalDrives

    For cnt = 0 To 25
        If (lDs And 2 ^ cnt) <> 0 Then
            driveName = Chr$(65 + cnt) & ":\"

            If GetDriveType(driveName) = 2 Then 'hanya flash disk yang kita proses
                dongleFile = driveName & "donglekey"

                strLabel = String$(255, Chr$(0))
                GetVolumeInformation driveName, strLabel, 255, serial, 0, 0, fSName, 255
                strLabel = Left$(strLabel, InStr(1, strLabel, Chr$(0)) - 1)

                GetVolumeInformation driveName, vbNullString, 255, serial, 0, 0, vbNullString, 255

                formatHex = Format(Hex(serial), "00000000")
                serialNumber = Left(formatHex, 4) & "-" & Right(formatHex, 4) 'serial number - plain text

                'serial number + security code yang sudah dienkripsi
                'security code -> harus sama dg yang di tool dongle
                generateKey = generateKeyByMD5(serialNumber & SECURITY_CODE)

                If generateKey = dongleKeyFile(dongleFile) Then
                    isValidDongle = True: Exit For
                End If
            End If
        End If
    Next cnt
End Function

Public Sub Main()
    If isValidDongle Then
        'TODO : tampilkan Form Utama disini
    Else
        MsgBox "Donglenya enggak valid atau belum dipasang.", vbExclamation, "Peringatan"
    End If
End Sub

Yap mungkin itu saja artikel sederhana bagaimana membuat aktivasi dengan dongle, untuk source code bisa didownload disini.

Selamat mencoba