Pemakaiannya mudah, tinggal jalankan program shareware.vbp kemudian sharetest untuk mengetes apa program tersebut sudah dibuat shareware, nah jika sudah habis masa waktunya program meminta no register dan silakan masukkan no register a1234.
Berikut bentuk tampilan programnya
script kodenya sebagai berikut :
'main form shareware
Private Sub Command1_Click()
frmshare.Show
End Sub
Private Sub Command2_Click()
Dim lresult As Long
lresult = DeleteRegKey("\Software\venky", "value")
lresult = DeleteRegKey("\Software\venky", "days")
lresult = DeleteRegKey("\Software\venky", "uses")
lresult = DeleteRegKey("\Software\venky", "lock")
lresult = DeleteRegKey("\Software", "venky")
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim lresult As Long
' Remove the test data from the registry
End Sub
'main form shareware
Private Sub Command1_Click()
Dim lresult As Long
Dim sKey As String
Dim sSubkey As String
Dim sSubkey1 As String
Dim sKeyValue1 As String
sKey = "\Software\venky\shareware"
frmMain.Command2.Enabled = True
If Option1(0).Value = True Then
sSubkey = "days"
If Option2(0).Value = True Then sKeyValue1 = (Date + 30)
If Option2(1).Value = True Then sKeyValue1 = (Date + 15)
If Option2(2).Value = True Then sKeyValue1 = (Date + 1)
lresult = SetRegValue(sKey, sSubkey, sKeyValue1)
lresult = SetRegValue(sKey, "value", Date)
lresult = SetRegValue(sKey, "lock", "true")
End If
If Option1(1).Value = True Then
sSubkey = "uses"
If Option2(3).Value = True Then sKeyValue1 = 1
If Option2(4).Value = True Then sKeyValue1 = 5
If Option2(5).Value = True Then sKeyValue1 = 10
lresult = SetRegValue(sKey, sSubkey, sKeyValue1)
lresult = SetRegValue(sKey, "value", "1")
lresult = SetRegValue(sKey, "lock", "true")
End If
MsgBox "Lock Made"
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
If Option1(0).Value = True Then
Option2(3).Value = False
Option2(4).Value = False
Option2(5).Value = False
End If
CreateRegKey ("\Software\venky\shareware")
End Sub
Private Sub Option1_Click(Index As Integer)
If Option1(0).Value = True Then
Option2(3).Value = False
Option2(4).Value = False
Option2(5).Value = False
End If
If Option1(1).Value = True Then
Option2(0).Value = False
Option2(1).Value = False
Option2(2).Value = False
End If
End Sub
Private Sub Option2_Click(Index As Integer)
If Option2(2).Value = True Then
Option1(1).Value = False
Option1(0).Value = True
End If
If Option2(1).Value = True Then
Option1(1).Value = False
Option1(0).Value = True
End If
If Option2(0).Value = True Then
Option1(1).Value = False
Option1(0).Value = True
End If
If Option2(3).Value = True Then
Option1(0).Value = False
Option1(1).Value = True
End If
If Option2(4).Value = True Then
Option1(0).Value = False
Option1(1).Value = True
End If
If Option2(5).Value = True Then
Option1(0).Value = False
Option1(1).Value = True
End If
End Sub
'main form testshareware
Dim op4 As Integer
Dim op1 As String
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Activate()
Dim lresult As Long
Dim sKeyValue As String
Dim op3 As Integer
Dim op As String
Dim op9 As Date
Dim op8 As Date
Dim op10 As Date
Dim op11 As String
lresult = GetRegValue("\Software\venky\shareware", "lock", sKeyValue)
If sKeyValue = "false" Then
Label1.Caption = "Registered Copy'"
Exit Sub
Exit Sub
End If
lresult = GetRegValue("\Software\venky\shareware", "days", sKeyValue)
If Not sKeyValue = "" Then
op = sKeyValue
op9 = op
op8 = Date
lresult = GetRegValue("\Software\venky\shareware", "value", sKeyValue)
op11 = sKeyValue
op10 = op11
If op10 > op8 Then
frmregister.Show
Exit Sub
End If
If op8 < op9 Then
Label1.Caption = (op9 - op8) & " days left"
Exit Sub
Else
frmregister.Show
End If
Else
lresult = GetRegValue("\Software\venky\shareware", "uses", sKeyValue)
op = sKeyValue
op3 = Val(op)
If op3 = 0 Then
MsgBox "Make A Lock First"
Unload frmmain
End If
lresult = GetRegValue("\Software\venky\shareware", "value", sKeyValue)
op1 = sKeyValue
op4 = Val(op1)
If op4 <= op3 Then
Label1.Caption = "This Program has been run " & op1 & " times from a maximum of " & op3 & " times"
Dim op2 As String
op4 = op4 + 1
op2 = op4
lresult = SetRegValue("\Software\venky\shareware", "value", op2)
Else
frmregister.Show
End If
End If
End Sub
'main form register
Private Sub Command1_Click()
If Text1.Text = "" Then
MsgBox "Please Enter Serial no"
Exit Sub
End If
If Text1.Text = "a1234" Then
Dim lresult As Long
lresult = SetRegValue("\Software\venky\shareware", "lock", "false")
If lresult = o Then MsgBox "Registration Successful"
Unload Me
frmmain.Show
Else: MsgBox "Bad Serial No"
End If
End Sub
Private Sub Command2_Click()
Unload Me
Unload frmmain
End Sub
