by Jonathan Liu (9 Submissions)
Category: Encryption
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 7th February 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about Login Module 1.0. A module designed to simplify user authentication within the application by inclu. Why not be the first to post a comment about Login Module 1.0. A module designed to simplify user authentication within the application by inclu.
