• Home
 · 
• Encryption
 · 
• Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ Ad

Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ Ad

Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ [email protected]

API Declarations


!!EndDec!!


Rate Extremely Simple Login Screen. 1 form 2 textboxes 2 command buttons. Please e-mail me comments @ Ad

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'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