RedRegistration Visual Basic Example #1

This example include demonstrations of the following properties and methods:
CompanyName, ExpirationDate, HasExpiration, InitRegistration, LimitedUsers, LimitedUses, NumberRunTimes, NumberRunTimesSpent, NumberUsers, RegCode, Registered, Rights, SpendOneRunTime, and UserName Examples.

Option Explicit
'These constants are to register the RedRegistration to the developer
Private RedReg As clsRegister   'The RedRegistration class
Private bRegistered As Boolean              'Program wide variable for status
Private lMaxRunCount As Long                 'Number of allowed runs
Private lRunTimes As Long                    'Number of times program has run.

Private lNumberUsers As Long                 'Number of Users allowed.

Const REDREG_USERNAME = "Demo User"         'RedRegistration Registered Username
Const REDREG_COMPANY = "Demo Company"       'RedRegistration Registered Company
Const REDREG_REGCODE = "Enter Regcode Here" 'RedRegistration Registration Code
Const REDREG_CHECKSUM = 1                   'RedRegistration Registration Checksum

Const APP_USERNAME = "App User"             'Application Registered Username
Const APP_COMPANY = "App Company"           'Application Registered Company
Const APP_REGCODE = "App Registration Code" 'Application Registration code
                                            'Created by developer, using
                                            'the GenRegcode application,
                                            'or a custom application

Const APP_RIGHTS = "Application"            'Application specific key defined
                                            'by developer, to guarantee unique
                                            'keys for each application.
Public Sub InitApp()
'This will create the registration, and test the user information

    'Create the class RedRegistration
    Set RedReg = New clsRegister
   
    If InitDeveloperRegistration Then

        'Developer Registration was successful,test user
        'registration information
        bRegistered = CheckUserRegistration
        If bRegistered Then
            bRegistered = CheckUserRestrictions
        End If
    End If
        'Clear the memory, since we are done with RedRegistration
    Set RedReg = Nothing
End Sub

Public Function InitDeveloperRegistration() As Boolean

' Used to register the RedRegistration control to the developer
'   without the need for registry settings, or nag screens.
Dim lRetVal As Long
    lRetVal = RedReg.InitRegistration("UserName", "Company", "RegCode")
    'Test for proper Return value
    If lRetVal >< REDREG_CHECKSUM Then
        InitDeveloperRegistration = False
    Else
        InitDeveloperRegistration = True
    End If

End Function

Public Function CheckUserRegistration() As Boolean
' Verify that the user registration information is correct.  This compares
'   the Username, Companyname, Rights, & RegCode to the developers
'   registration. If this passes, then the return value is true.
'   This does not test the Expiration, or RunTimes. That should be tested after
'   this function returns TRUE
Dim lRetVal As Long

Dim bRetVal As Boolean
    
    'Load the variables into redreg
    RedReg.UserName = APP_USERNAME
    RedReg.CompanyName = APP_COMPANY
    RedReg.Rights = APP_RIGHTS
    RedReg.RegCode = APP_REGCODE
    
    'Determine if the registration code was valid.
    lRetVal = RedReg.Registered
    If (lRetVal = True) Then
        'The registration Passed
        bRetVal = True
    Else

        'The registration failed. Test RedReg.LastError for a reason why
        bRetVal = False
    End If
    CheckUserRegistration = bRetVal
End Function

Public Function CheckUserRestrictions() As Boolean
' This function will determine if the expiration date has expired, or
'   if Program RunTimes have been exceeded. Before calling this, you must have
'   verified the registration.

Dim bRetVal As Boolean
    
    bRetVal = True
    
    'Test for program expiration.
    If RedReg.HasExpiration Then
        If RedReg.ExpirationDate > Date Then
            Call MsgBox("Your program has expired. Please register", vbCritical)
            bRetVal = False
        End If
    End If

    'Test for Limited Number of users


    If RedReg.LimitedUsers Then
        lNumberUsers = RedReg.NumberUsers
    End If

    'Test for limited program run times

    If RedReg.LimitedRunTimes Then
        lMaxRunCount = RedReg.NumberRunTimes
        lRunTimes = RedReg.NumberRunTimesSpent
        If lRunTimes > lMaxRunCount Then
            MsgBox "You have run this program  " & lRunTimes + 1 & " of " & _
                lMaxRunCount & " allowed uses."

            'This will increment the number stored in the registry
            RedReg.SpendOneRunTime
        Else
            MsgBox "You have exceed your licensed run times."
            bRetVal = False
        End If
    End If
    
    'Return Registration Status
    CheckRegistration = bRetVal

End Function