Aplikasi trial adalah aplikasi yang mempunyai batasan waktu penggunaan
berdasarkan lama hari atau berapa kali aplikasi dijalankan.
Pembuatanya biasanya digunakan pada aplikasi shareware (berbayar) yang
bertujuan agar user dapat menikmati aplikasi (demo) sebelum membeli
aplikasi.
Berikut ini adalah contoh pembuatan aplikasi trial yang menggunakan
lama hari penggunaan, lengkap dengan prosedur input kode registrasinya.
Buat Project baru dengan sebuah Form. Di bagian '(Declarations)' dari Form ketikkan :
Const LocationReg = "System\Windows\User" 'lokasi penyimpanan d registry (ubah sesuai selera)
Const PasswordReg = "kode" 'kode kunci registrasi
Function GetInfoReg() As String 'fungsi utk mendapatkan info registrasi
Dim Reg = CreateObject("WScript.Shell")
Try
GetInfoReg = Reg.RegRead("HKEY_CLASSES_ROOT\" & LocationReg & "\")
Catch
Reg.RegWrite("HKEY_CLASSES_ROOT\" & LocationReg & "\", Now.Date) 'memasukkan tgl sekarang
GetInfoReg = Now.Date
End Try
End Function
Function SuccessReg() As Boolean 'fungsi utk prosedur pemasukan kode registrasi
Dim s As String
Lagi:
s = InputBox("Masukkan kode registrasi", "Registrasi")
If s = PasswordReg Then
Dim Reg = CreateObject("WScript.Shell")
Reg.RegWrite("HKEY_CLASSES_ROOT\" & LocationReg & "\", "Registered") 'mendaftarkan k registry
MsgBox("Terima kasih telah melakukan registrasi", vbInformation, "Registrasi Sukses")
SuccessReg = True
ElseIf s = "" Then
SuccessReg = False
Else
If MsgBox("Maaf kode registrasi salah, coba lagi ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then GoTo Lagi
SuccessReg = False
End If
End Function
Const PasswordReg = "kode" 'kode kunci registrasi
Function GetInfoReg() As String 'fungsi utk mendapatkan info registrasi
Dim Reg = CreateObject("WScript.Shell")
Try
GetInfoReg = Reg.RegRead("HKEY_CLASSES_ROOT\" & LocationReg & "\")
Catch
Reg.RegWrite("HKEY_CLASSES_ROOT\" & LocationReg & "\", Now.Date) 'memasukkan tgl sekarang
GetInfoReg = Now.Date
End Try
End Function
Function SuccessReg() As Boolean 'fungsi utk prosedur pemasukan kode registrasi
Dim s As String
Lagi:
s = InputBox("Masukkan kode registrasi", "Registrasi")
If s = PasswordReg Then
Dim Reg = CreateObject("WScript.Shell")
Reg.RegWrite("HKEY_CLASSES_ROOT\" & LocationReg & "\", "Registered") 'mendaftarkan k registry
MsgBox("Terima kasih telah melakukan registrasi", vbInformation, "Registrasi Sukses")
SuccessReg = True
ElseIf s = "" Then
SuccessReg = False
Else
If MsgBox("Maaf kode registrasi salah, coba lagi ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then GoTo Lagi
SuccessReg = False
End If
End Function
Lalu di bagian 'Form1_Load' ketikkan :
Dim s As String, l As Long
s = GetInfoReg()
If s <> "Registered" Then 'jika belum terdaftar"
l = 30 - CType(Now.Date - CDate(s), TimeSpan).TotalDays 'max penggunaan trial 30 hari
If l > 0 And l <= 30 Then 'jika masih ada sisa hari
If MsgBox("Aplikasi ini hanya dapat digunakan sampai " & l & " hari lagi." & vbCrLf & _
"Jika ingin menggunakan tanpa batasan waktu, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbInformation, "Registrasi") = vbYes Then SuccessReg()
Else 'jika kadaluarsa
If MsgBox("Aplikasi ini sudah tidak dapat digunakan lagi." & vbCrLf & _
"Jika ingin menggunakannya kembali, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then
If SuccessReg() = False Then End 'mengakhiri aplikasi
Else
End 'mengakhiri aplikasi
End If
End If
End If
s = GetInfoReg()
If s <> "Registered" Then 'jika belum terdaftar"
l = 30 - CType(Now.Date - CDate(s), TimeSpan).TotalDays 'max penggunaan trial 30 hari
If l > 0 And l <= 30 Then 'jika masih ada sisa hari
If MsgBox("Aplikasi ini hanya dapat digunakan sampai " & l & " hari lagi." & vbCrLf & _
"Jika ingin menggunakan tanpa batasan waktu, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbInformation, "Registrasi") = vbYes Then SuccessReg()
Else 'jika kadaluarsa
If MsgBox("Aplikasi ini sudah tidak dapat digunakan lagi." & vbCrLf & _
"Jika ingin menggunakannya kembali, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then
If SuccessReg() = False Then End 'mengakhiri aplikasi
Else
End 'mengakhiri aplikasi
End If
End If
End If
0 komentar:
Post a Comment