by Adam Melton (5 Submissions)
Category: Encryption
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 25th February 2005
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ [email protected]
API Declarations
!!EndDec!!
VBcoders
'2 textboxes (text1, txtLogin)
'2 command buttons (cmdCancel,cmdOk) that's it.
Dim pwd As String
Dim strAppname
Dim strSection
Dim strKey
Dim strDefault
Private Sub cmdCancel_Click()
End
End Sub
Private Sub cmdOK_Click()
'if textbox equals saved password then accept
If txtLogin.Text = pwd Then
MsgBox "Password Accepted"
Unload Me
Else
MsgBox "Invalid Password !", vbExclamation, "Sorry !"
txtLogin.SetFocus
txtLogin.SelStart = 0
txtLogin.SelLength = Len(txtLogin.Text)
End If
End Sub
Private Sub Form_Load()
Dim strPass
Dim strPass2
strPass = ""
strPass2 = ""
'name the below captions whatever you want to
'application name
strAppname = "Login"
'section name
strSection = "Login Pword"
'key name
strKey = "Pword"
'default password
strDefault = "?'~14"
If App.PrevInstance Then
End
End If
' get the password default or pre-saved
pwd = GetSetting(strAppname, strSection, strKey, strDefault)
'check if this is the first time the program is used
If pwd = strDefault Then
MsgBox "Thank you for choosing " & strAppname & vbCrLf & "Please set your password", vbInformation, "Welcome !"
'uses input boxes to aquire new passwords
Do
strPass = InputBox("Enter Password", "Create Password")
If strPass = "" Then
End
Else
strPass2 = InputBox("ReenterPassword", "Varify Password")
End If
If strPass <> strPass2 Then
MsgBox "Passwords Don't Match!"
End If
Loop While strPass <> strPass2
'I had to use the text1 otherwise i get a byref error if you know a way to fix/by pass this please e-mail me
Text1.Text = pass
SaveSetting strAppname, strSection, strKey, EncryptPassword(Text1.Text) 'Right here is where
MsgBox "Password Accepted"
'you can unload into the next form of your choice or just end,
'either way you have to end this form because it will only accept "" (nothing) as the password
'form2.show
Unload Me
End If
pwd = DecryptPassword(pwd)
End Sub
'decrypts the password so that it can not be viewed without the key
Private Function DecryptPassword(pword As String)
parr = Split(pword, " ")
pword = ""
For i = LBound(parr) + 1 To UBound(parr)
parr(i) = Asc(parr(i)) - 10
parr(i) = parr(i) Xor 3
pword = pword + Chr(parr(i))
Next
DecryptPassword = pword
End Function
'encrypts the password so that it can't be view by the wrong program
Private Function EncryptPassword(pword As String)
'you can change the encryption method but make shure that you are able to decrypt it.
Dim parr()
ReDim parr(Len(pword))
For i = 1 To Len(pword)
parr(i) = Asc(Mid(pword, i, 1))
parr(i) = parr(i) Xor 3
parr(i) = Chr(parr(i) + 10)
Next
EncryptPassword = Join(parr)
End Function
No comments have been posted about Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ Ad. Why not be the first to post a comment about Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ Ad.
