Option Explicit
Private MainPath As String
Private Type UNPW_STRUCT
UName As String
PWord As String
End Type
Private UNPW() As UNPW_STRUCT
Private MaxUNPW As Long
Private Sub cmdLogin_Click()
Select Case TryLogin(txtName.Text, txtPass.Text)
Case 0 ' Everythings Ok
Me.Hide
frmShop.Show
Case 1 ' User Name Not Valid
MsgBox "User Name Not Valid", vbOKOnly, "Login Denied"
Case 2 ' Password Not Valid
MsgBox "Password Not Valid", vbOKOnly, "Login Denied"
End Select
End Sub
Private Function TryLogin(ByVal UName As String, ByVal PWord As String) As Long
Dim ReturnValue As Long ' Value to return
Dim t As Long ' a counter variable
Dim FoundUname As Boolean ' flag
Dim FoundPword As Boolean ' flag
ReturnValue = 3 ' set to unspecified error
FoundUname = False
FoundPword = False
If LoadUNPWs() Then
For t = 0 To MaxUNPW - 1
If UCase(UName) = UCase(UNPW(t).UName) Then ' non case sensitive...remove ucase if you want it to be
FoundUname = True
If UCase(PWord) = UCase(UNPW(t).PWord) Then ' non case sensitive...remove ucase if you want it to be
FoundPword = True
ReturnValue = 0 ' done
Exit For
End If
End If
Next t
If Not FoundUname Then
ReturnValue = 1 ' ooh bab uname
ElseIf Not FoundPword Then
ReturnValue = 2 ' ooh bad pword
End If
End If
TryLogin = ReturnValue
End Function
Private Function LoadUNPWs() As Boolean
Dim Success As Boolean ' Return Value
Dim FileSpec As String ' Our filespec
Dim FP As Long ' the File Pointer
Dim FileBody As String ' holds the file doby
Dim FileLine As String ' holds a line
Dim P As Long ' positional item
Dim FSO As Object ' File System Object
Set FSO = CreateObject("Scripting.FileSystemObject") ' make one
Success = True ' set initial return value to true
FileSpec = App.Path ' Set Filespec to app.path
' Check for trailing paddy
If Right(FileSpec, 1) <> "\" Then
FileSpec = FileSpec & "\"
End If
FileSpec = FileSpec & "usr.txt" ' add text file
If FSO.FileExists(FileSpec) Then
FP = FreeFile() ' now get free file pointer
Open FileSpec For Input As #FP ' Open the file
FileBody = Input(LOF(FP), #FP) ' load the whole thing
Close #FP ' close the file
' My File Looks Like This: (un pw separated by pipe)
' USERNAME|PASSWORD
' USERNAME|PASSWORD
' USERNAME|PASSWORD
' USERNAME|PASSWORD
MaxUNPW = 0 ' initialize our variable
ReDim UNPW(1) As UNPW_STRUCT ' clear it out
Do While Len(FileBody) > 0 ' loop for loading un/pws
P = InStr(1, FileBody, vbCrLf) ' find end of line
If P > 0 Then
FileLine = Left(FileBody, P - 1) ' get a line
FileBody = Mid(FileBody, P + 2, Len(FileBody)) ' remove that line
Else
FileLine = FileBody ' get the whole thing
FileBody = "" ' delete it all
End If
P = InStr(1, FileLine, "|") ' find out pipe
If P > 0 Then
MaxUNPW = MaxUNPW + 1
ReDim Preserve UNPW(MaxUNPW) As UNPW_STRUCT ' preserve it but make it bigger
UNPW(MaxUNPW - 1).UName = Left(FileLine, P - 1) ' add the name
UNPW(MaxUNPW - 1).PWord = Mid(FileLine, P + 1, Len(FileLine)) ' add the password
Else
MsgBox "Authentication File Is Not Correct Format", vbOKOnly, "Fatal Error"
Success = False
End If
Loop
Else
MsgBox "Authentication File Not Found.", vbOKOnly, "Fatal Error"
Success = False
End If
Set FSO = Nothing ' delete the object
LoadUNPWs = Success
End Function
Enjoy,
Chi
"They mostly come at night...mostly"
