Langsung saja proses pembuatan trial aplikasi pada vb 6.0 :
Coretan Koding :
Const LocationReg = "System\Windows\apk software" 'disini tempat penyimpanan registry (boleh diganti sesuai dengan yang anda inginkan
Function GetInfoReg() As String
On Error GoTo EroBacaRegistry
Dim Reg As Object
Set Reg = CreateObject("WScript.Shell")
GetInfoReg = Reg.RegRead("HKEY_CLASSES_ROOT\" & LocationReg & "\")
Exit Function
EroBacaRegistry:
Reg.RegWrite "HKEY_CLASSES_ROOT\" & LocationReg & "\", Format(Now, "short date") 'fungsi Now untuk memasukan tgl sekarang/tgl dikomputer
GetInfoReg = Format(Now, "short date")
End Function
'fungsi utk mendapatkan info dari registry
Private Sub cek_program()
Dim s, pesan As String, l As Long
s = GetInfoReg
If s <> "Registrasi" Then 'jika belum terdaftar"
l = 30 - (CDate(Format(Now, "short date")) - CDate(s)) 'max penggunaan trial 30 hari
If l > 0 And l <= 30 Then 'jika masih ada sisa hari
If MsgBox("Aplikasi Software hanya dapat digunakan sampai " & l & " hari lagi." & vbCrLf & _
"Jika ingin menggunakan tanpa batasan waktu, masukkan kode registrasi/lisensi" & vbCrLf & _
"Jika ingin tetap melanjutkan aplikasi trial, Pilih No" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi/lisensi sekarang ?", vbYesNo + vbInformation, "Registrasi") = vbYes Then
MsgBox "Tampilkan form registrasi program anda disini", vbInformation, "apk software regist"
'tampilkan form registrasinya disini
End If
Else 'jika masa berlaku habis (lebih dari 30 hari)
pesan = MsgBox("apk software regist sudah tidak dapat digunakan lagi." & vbCrLf & _
"Jika ingin menggunakannya kembali, masukkan kode registrasi/lisensi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi/license sekarang ?", vbYesNo + vbExclamation, "Registrasi")
If pesan = vbYes Then
MsgBox "Tampilkan form registrasi program anda", vbInformation, "apk software regist"
End
Else
End
End If
End If
End If
End Sub
Private Sub Form_Load()
cek_program
Dim s As String, l As Long
s = GetInfoReg
If s <> "Registrasi" Then
l = 30 - (CDate(Format(Now, "short date")) - CDate(s))
If l > 0 And l <= 30 Then
'perintah jika masa trial masih ada
Else
'perintah jika masa trial sudah habis
End If
End If
End Sub
