//**************************************
// Name: account management sample
// Description:Rate this Account Code
// By: Paul Ishak
//
//This code is copyrighted and has// limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=8156&lngWId=10//for details.//**************************************
Module AccountManagement
Public UserPrivilages As String 'Contains the users privilages, Do not manually set this variable
Public UserAccount As String ' Contains AllAccount Information, Do not manually set this variable
Public UserName As String 'Contains Username, Do Not Manually Set This Variable
Public UserPassword As String ' Used for hashing passwords, Do not Manually Set This Variable
Public LoginStatus As Boolean = False ' Used for Internally Recognizing if a user is logged, Do not manually set this variable
Public ENCRYPTEDAccountDatabase As String ' Target variable for the accounts Database, Do Not Manually set this variable
Public AccountDatabase As String
Public AccessDeniedMessage As String = "Access Denied" 'If the next variable is Enabled, this message will be displayed. You can customize it.
Public EnableAccessDeniedMessage As Integer = 1 ' 1 = Enabled, 0 = Disabled
Public AppTitle As String = "Not Assigned" 'Manually set your application title here
Public Version As String = "1.0 beta" ' Manually set the version of your application here
Public TitleBarCaption As String = Trim(AppTitle) & " " & Trim(Version) 'do not change this variable, this is for the titlebar of the messagebox's
Public PrivilageList As String
Function DoesUserHaveAccess(ByVal ToWhat As String) As String
Dim Answer As String = "NO"
If InStr(UserPrivilages, ToWhat, CompareMethod.Text) > 0 Then
Answer = "YES"
End If
Return Answer
End Function
Function CreatePrivilageType(ByVal Privilage As String, ByVal Description As String)
PrivilageList = PrivilageList & "<Privilage>" & Privilage & "<Description>" & Description & "</Privilage>"
Return vbNull
End Function
Function ListPrivilageType() As String
If Len(PrivilageList) < 1 Then
MsgBox("No Privilages To List", vbOKOnly, TitleBarCaption)
Else
End If
Return PrivilageList
End Function
Function ValidateLogin(ByVal LoginName As String, ByVal LoginPassword As String) As Boolean
'This is the Main Login Function
Dim Account As String
Account = ParseDatabase(AccountDatabase, LoginName)
If Len(Account) > 1 Then Return False
If InStr(Account, "<username>" & LoginName & "</username>", CompareMethod.Text) > 0 Then
If InStr(Account, "<password>" & LoginPassword & "</password>", CompareMethod.Text) > 0 Then
UserName = LoginName
UserAccount = Account
LoginStatus = True
UserPrivilages = ResolveAccountPrivilages(UserAccount)
Return True
Else
Return False
End If
Else
Return False
End If
Return False
End Function
Function ResolveAccountPrivilages(ByVal LoginAccount As String) As String
Dim letter As String = ""
Dim letterb As String = ""
Dim word As String = ""
'<account><username><password>|USERPRIVILAGESGOHERE
For i = 1 To Len(LoginAccount)
letter = Mid$(LoginAccount, i, 1)
If letter = "|" Then
For ii = i + 1 To Len(LoginAccount)
letterb = Mid$(LoginAccount, ii, 1)
If letterb = "<" Then GoTo 10
word = word & letterb
Next
End If
Next
10:
Return word
End Function
Public Function ParseDatabase(ByVal Database As String, ByVal User As String) As String
Dim letter As String = ""
Dim word As String = ""
Dim MatchingAccount As String = ""
For i = 1 To Len(Database)
letter = Mid$(Database, i, 1)
word = word & letter
If InStr(word, "</account>", CompareMethod.Text) > 0 Then
If InStr(word, UserName, CompareMethod.Text) > 0 Then
MatchingAccount = word
GoTo 10
End If
word = ""
End If
Next
10:
Return MatchingAccount
End Function
End Module
|
