Const LocationReg = "System\Windows\User"
Const PasswordReg = "kode"
Function GetInfoReg() As String
On Error GoTo Ero
Dim Reg As Object
Set Reg = CreateObject("WScript.Shell")
GetInfoReg = Reg.RegRead("HKEY_CURRENT_USER\Software\A" & LocationReg & "\")
Exit Function
Ero:
Reg.RegWrite "HKEY_CURRENT_USER\Software\A" & LocationReg & "\", Format(Now, "short date")
GetInfoReg = Format(Now, "short date")
End Function
Function SuccessReg() As Boolean
Dim s As String
Lagi:
s = InputBox("Masukkan kode registrasi", "Registrasi")
If s = PasswordReg Then
Dim Reg As Object
Set Reg = CreateObject("WScript.Shell")
Reg.RegWrite "HKEY_CURRENT_USER\Software\A" & LocationReg & "\", "Registered"
MsgBox "Terima kasih telah melakukan registrasi", vbInformation, "Registrasi Sukses"
SuccessReg = True

ElseIf s = "kode" 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
Private Sub Form_Load()
Dim s As String, l As Long

s = GetInfoReg
If s <> "Registered" Then
l = 30 - (CDate(Format(Now, "short date")) - CDate(s))

If l > 0 And l <= 30 Then
If MsgBox("Aplikasi ini dapat digunakan sampai " & l & " hari lagi." & vbCrLf & _
"Jika ingin menggunakan tanpa batasan waktu, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi ?", vbYesNo + vbInformation, "Registrasi") = vbYes Then SuccessReg

Else
If MsgBox("Aplikasi ini 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
Else
End
End If

End If
End If
End Sub