Important alert: (current site time 9/2/2014 4:48:30 AM EDT)
 

article

Software Users Account Management

Email
Submitted on: 3/13/2012 4:39:19 PM
By: Paul Ishak 
Level: Advanced
User Rating: Unrated
Compatibility: C#, VB.NET
Views: 4889
author picture
(About the author)
 
     This is a registry based account login/permission validation system for the internal functions and uses of your application that may require a login. Please do not confuse this with windows account management, as it is not the same thing. Enjoy =)

 
 
Terms of Agreement:   
By using this article, you agree to the following terms...   
  1. You may use this article in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this article (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this article from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the article or article's description.
				Option Strict On
Imports Microsoft.Win32
Imports System.Text
Imports System.Security.Cryptography
Public Module AccountManagement
'Please enjoy this example.
'
'The Name of the Root key where your accounts will be stored(appkey)
'You need to set this to whatever you want
'
Public AppKey As String = "TESTAPPTITLE"
'
'
'
'
'
'
'
'it will be a subkey of this------------>
Public MyRegistryKey As String = "Software\" & AppKey
'The main Root Node(further modification will be needed if you attempt to use HKLM)...
Public Node As String = "HKEY_CURRENT_USER\"
'The path to the key of your stored values
Public MyUsersRegistryKey As String = Node & MyRegistryKey & "\" & "Users"
'The current user
Public CurrentUserName As String
'Tells if the user is logged in or not
Public LoggedIn As Boolean = False
'The list of allowable characters for usernames/passwords
Public ValidPasswordCharacters As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890`1234567890-=!@#$%^&*()_+[]\;',./{}|:""<>? "
Public ValidUserNameCharacters As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Public Function Accounts() As List(Of String)
'This function will return a list of account names
Dim regKey As Microsoft.Win32.RegistryKey
regKey = Registry.CurrentUser.OpenSubKey(MyUsersRegistryKey, True)
Dim AccountNames() As String = regKey.GetSubKeyNames
Dim AccountList As New List(Of String)
For Each Subkey As String In AccountNames
AccountList.Add(Subkey)
Next
Return AccountList
End Function
Public Function AllowLogin(ByVal UserName As String, ByVal Password As String) As Boolean
If CreateHash(UserName & Password) = GetStoredUserHash(UserName) Then
Return True
Else
Return False
End If
End Function
Public Sub ChangePassword(ByVal ExisitingAccountName As String, ByVal NewPassword As String)
Dim CurrentUserSubKey As String = Node & MyUsersRegistryKey & "\" & ExisitingAccountName
Dim PWHash As String = CreateHash(ExisitingAccountName & NewPassword)
SetValue(CurrentUserSubKey, "Hash", PWHash)
End Sub
Public Sub CreateAccount(ByVal NewAccountName As String, ByVal Password As String, ByVal IsAdmin As Boolean)
Select Case ContainsValidCharacters(NewAccountName, Vmode.UserName)
Case True
Select Case ContainsValidCharacters(Password, Vmode.Password)
Case True
Dim CurrentUserSubKey As String = Node & MyUsersRegistryKey & "\" & NewAccountName
Dim PWHash As String = CreateHash(NewAccountName & Password)
My.Computer.Registry.CurrentUser.CreateSubKey(CurrentUserSubKey)
SetValue(CurrentUserSubKey, "UserName", NewAccountName)
SetValue(CurrentUserSubKey, "Hash", PWHash)
'------------------------------
'This is where you would add your custom permissions
'------------------------------
'First you put the user's subkey, then the name of the permission, then whether the user is granted that permission or not
'Replace these with whatever you want
AddPermission(CurrentUserSubKey, "Read", True)
AddPermission(CurrentUserSubKey, "Write", True)
AddPermission(CurrentUserSubKey, "Access", True)
AddPermission(CurrentUserSubKey, "Function1", True)
AddPermission(CurrentUserSubKey, "Function2", True)
AddPermission(CurrentUserSubKey, "Function3", True)
AddPermission(CurrentUserSubKey, "Function4", True)
Case Else
MsgBox("The password for the new account contains invalid characters!")
End Select
Case Else
MsgBox("The new account name contains invalid characters!")
End Select
End Sub
Public Function AccessIsAllowed(ByVal CurrentUser As String, ByVal RequiredPermission As String) As Boolean
Dim CurrentUserSubKey As String = Node & MyUsersRegistryKey & "\" & CurrentUser
If PermissionGranted(CurrentUserSubKey, RequiredPermission) = True Then
Return True
Else
Return False
End If
End Function
Public Sub SampleFunctionWithRequiredPermission()
If AccessIsAllowed(CurrentUserName, "Function1") = True Then
'Some Code
'Some Functionality
'Some Result
MsgBox("Access Granted!")
Else
MsgBox("Access Denied!")
End If
End Sub
Public Sub AddPermission(ByVal CurrentUserSubKey As String, ByVal PermissionName As String, ByVal GrantPermission As Boolean)
SetValue(CurrentUserSubKey, PermissionName, GrantPermission)
End Sub
Public Function CreateHash(ByVal SourceText As String) As String
Dim Ue As New UnicodeEncoding()
Dim ByteSourceText() As Byte = Ue.GetBytes(SourceText)
Dim Md5 As New MD5CryptoServiceProvider()
Dim ByteHash() As Byte = Md5.ComputeHash(ByteSourceText)
Return System.Convert.ToBase64String(ByteHash)
End Function
Public Sub DeleteAccount(ByVal UserName As String)
My.Computer.Registry.CurrentUser.DeleteSubKey(MyUsersRegistryKey & "\" & UserName)
End Sub
Public Function GetStoredUserHash(ByVal UserName As String) As String
Dim Hash As String
Dim CurrentUserSubKey As String = Node & MyUsersRegistryKey & "\" & UserName
Hash = DirectCast(My.Computer.Registry.GetValue(CurrentUserSubKey, "Hash", 0), String)
Return Hash
End Function
Public Sub Login(ByVal UserName As String, ByVal Password As String)
If AllowLogin(UserName, Password) = True Then
CurrentUserName = UserName
LoggedIn = True
'-------------------------
'Your Extended Login Code
'-------------------------
End If
End Sub
Public Sub Logoff()
CurrentUserName = ""
LoggedIn = False
'--------------------
'Your Extended Code To Logoff
'--------------------
End Sub
Public Sub SetValue(ByVal Key As String, ByVal ValueName As String, ByVal Value As Object)
My.Computer.Registry.SetValue(Key, ValueName, Value)
End Sub
Public Function PermissionGranted(ByVal Key As String, ByVal ValueName As String) As Boolean
Try
Return DirectCast(My.Computer.Registry.GetValue(Key, ValueName, False), Boolean)
Catch
Return False
End Try
End Function
Public Function ContainsValidCharacters(ByVal Item As String, ByVal ValidationMode As Vmode) As Boolean
Select Case ValidationMode
Case Vmode.Password
For Each letter As String In Item
If InStr(ValidPasswordCharacters, letter) < 1 Then
Else
Return False
End If
Next
Return True
Case Vmode.UserName
For Each letter As String In Item
If InStr(ValidUserNameCharacters, letter) < 1 Then
Else
Return False
End If
Next
Return True
Case Else
Return False
End Select
End Function
Public Enum Vmode
UserName
Password
End Enum
End Module


Other 17 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this article (in the Advanced category)?
(The article with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular article, please click here instead.)
 

To post feedback, first please login.