• Home
 · 
• Encryption
 · 
• Login Module 1.0. A module designed to simplify user authentication within the application by inclu

Login Module 1.0. A module designed to simplify user authentication within the application by inclu

Login Module 1.0. A module designed to simplify user authentication within the application by including sub-routines and function for adding

API Declarations


'by Buttress Root Software
'
'Programmed by Jonathan Liu
'Copyright ©1999-2371 Buttress Root Software. All rights reserved.

Option Explicit
Private Users() As lmUser
Private strUsernames() As String
Private strPasswords() As String

Private Type lmUser
Username As String
Password As String
End Type



Rate Login Module 1.0. A module designed to simplify user authentication within the application by inclu

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Sub AddUsername(ByVal strUsername As String, ByVal strPassword As String)
Dim sngFreeSlot As Single
Dim i As Single

Call InitialiseArrays
If strUsername = "" Then Exit Sub

For i = 0 To UBound(Users)
    If LCase$(Users(i).Username) = strUsername Then Exit Sub
Next i

sngFreeSlot = -1

For i = 0 To UBound(Users)
    If Users(i).Username = "" Then
        sngFreeSlot = i
        Exit For
    End If
Next i

If sngFreeSlot = -1 Then
    sngFreeSlot = UBound(Users) + 1
    ReDim Preserve Users(sngFreeSlot)
End If

Users(sngFreeSlot).Username = strUsername
Users(sngFreeSlot).Password = strPassword

Call OptimiseLoginArray
End Sub

Sub RemoveUsername(ByVal strUsername As String)
Dim sngSlot As Single
Dim i As Single

Call InitialiseArrays
If strUsername = "" Then Exit Sub
sngSlot = -1

For i = 0 To UBound(Users)
    If LCase(Users(i).Username) = LCase(strUsername) Then
        sngSlot = i
        Exit For
    End If
Next i

If sngSlot = -1 Then Exit Sub

Users(sngSlot).Username = ""
Users(sngSlot).Password = ""

Call OptimiseLoginArray
End Sub

Sub InitialiseArrays()
If IsArrayEmpty() = False Then Exit Sub
ReDim Users(0)
End Sub

Sub OptimiseLoginArray()
Dim sngFreeSlot As Single
Dim i As Single

Call InitialiseArrays

Do
DoEvents
sngFreeSlot = -1

For i = 1 To UBound(Users) - 1
    If Users(i).Username = "" Then
        sngFreeSlot = i
        Exit For
    End If
Next i

If sngFreeSlot >= 1 Then
    For i = sngFreeSlot + 1 To UBound(Users)
        Users(i - 1).Username = Users(i).Username
        Users(i - 1).Password = Users(i).Password
    Next i
    
    ReDim Preserve Users(UBound(Users) - 1)
Else
    If Users(UBound(Users)).Username = "" And UBound(Users) > 0 Then _
        ReDim Preserve Users(UBound(Users) - 1)
    Exit Do
End If
Loop
End Sub

Function IsArrayEmpty() As Boolean
On Error Resume Next
Dim sngUBound As Single

sngUBound = UBound(Users)

If Err.Number <> 0 Then
    IsArrayEmpty = True
Else
    IsArrayEmpty = False
End If
End Function

Function LoginValid(ByVal strUsername As String, ByVal strPassword As String) As Boolean
Dim sngFreeSlot As Single
Dim i As Single

Call InitialiseArrays
If strUsername = "" Then Exit Function
sngFreeSlot = -1

For i = 0 To UBound(Users)
    If LCase(Users(i).Username) = LCase(strUsername) Then
        sngFreeSlot = i
        Exit For
    End If
Next i

If sngFreeSlot = -1 Then Exit Function
If LCase(Users(sngFreeSlot).Password) = LCase(strPassword) Then LoginValid = True
End Function