Sunday, February 27, 2011

0 Tutor membuat Serial Number

Pertama buka VB6

sediakan

  • 2 label, label 1 beri nama Serial Number & label 2 Activation key
  • 3 comand button, 1beri nama cmdHint caption Hint, cmd 2 beri nama cmdCancel caption Cancel, cmd 3 berinama cmdOk Caption Ok
  • 2.text box


oke masuk kan SC nie:

Option Explicit

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 Function GetHDDSerialNumber(ByVal DriveLetter As String) As String
Dim SN As Long
Dim VolumeNameBuff As String
Dim FileSystemBuff As String

VolumeNameBuff = String$(255, Chr$(0))
FileSystemBuff = String$(255, Chr$(0))
GetVolumeInformation UCase(DriveLetter) & “:\”, _
VolumeNameBuff, 255, SN, 0, 0, FileSystemBuff, 255
GetHDDSerialNumber = Trim(Hex$(SN))
End Function

Private Function CreateAppSerialNumber _
(ByVal HDDSerialNumber As String) As String
Dim i As Integer
Dim temp As String
Dim temp2 As String

temp = Empty
For i = 1 To Len(HDDSerialNumber) Step 2
temp = temp & Mid(HDDSerialNumber, i + 1, 1) & _
Mid(HDDSerialNumber, i, 1)
Next

For i = Len(temp) To 1 Step -1
Select Case Asc(Mid(temp, i, 1)) + 1
Case 48 To 57, 65 To 90, 97 To 122
temp = temp & Chr(Asc(Mid(temp, i, 1)) + 1)
Case Else
temp = temp & Mid(temp, i, 1)
End Select
Next

For i = 1 To Len(temp) Step 2
temp2 = temp2 & Mid(temp, i, 1) & _
Mid(temp, Len(temp) \ 2 + i, 1)
Next

CreateAppSerialNumber = temp2
End Function

Public Function CreateActivationKey _
(ByVal AppSerialNumber As String) As String
Dim i As Integer
Dim j As Integer
Dim temp As String

temp = Empty
For i = 1 To Len(AppSerialNumber) \ 2
temp = temp & (Asc(Mid(AppSerialNumber, i, 1)) Xor _
Asc(Mid(AppSerialNumber, Len(AppSerialNumber) \ 2 + 1, 1)))
Next
CreateActivationKey = Hex$(Val(temp))
End Function

Private Sub Form_Load()
txtSerialNumber.Text = CreateAppSerialNumber(GetHDDSerialNumber(”c”))
End Sub

Private Sub cmdHint_Click()
MsgBox “Activation Key: ” & _
CreateActivationKey(CreateAppSerialNumber _
(GetHDDSerialNumber(”C”)))
End Sub

Private Sub cmdOK_Click()
If txtActivationKey.Text = CreateActivationKey(txtSerialNumber.Text) Then
MsgBox “Thank you!”, vbOKOnly Or vbInformation, App.Title
Else
MsgBox “Wrong answer!”, vbOKOnly Or vbInformation, App.Title
End If
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub



okeh segitu ajh

0 komentar:

Post a Comment