# Password Protection Ideas

**URL:** <https://forums.thehomestack.io/t/password-protection-ideas/200>\
**Category:** vb.Net\
**Created:** [January 12, 2005, 4:14am UTC](https://forums.thehomestack.io/t/password-protection-ideas/200 "2005-01-12T04:14:22Z")\
**Posts on this page:** 1\
**Page:** 1

<div class="post-metadata">

**Author:** ![system](https://forums.thehomestack.io/uploads/default/original/1X/161426793bc0d8bdf0d1a6692b3e44446861cc72.jpeg) [@system](https://forums.thehomestack.io/u/system)\
**Post date:** [January 12, 2005, 4:14am UTC](https://forums.thehomestack.io/t/password-protection-ideas/200/1 "2005-01-12T04:14:22Z")

</div>

```auto

'VERIFY USER AND PASSWORD 
    Set objUserDBRS = New ADODB.Recordset 
    EncryptedPassword = SEC_EncryptOnly(txtPassword.Text, "passkeyencryptor") 
    TempSql = "Select * from [Users] where UserName = '" & LCase(txtUserName.Text) & _ 
                   "' and UserPassword = '" & EncryptedPassword & "'" 
     
    With objUserDBRS 
        If .State = adStateOpen Then .Close 
        .ActiveConnection = objMainDBCon 
        .CursorType = adOpenKeyset 
        .Source = TempSql 
        .Open 
         
        If .RecordCount = 0 Then 
            tempanswer = MsgBox("User Name or password incorrect. Try again.", vbExclamation, "Incorrect Login") 
            txtUserName.SetFocus 
            SendKeys "{Home}+{End}" 
            GoTo EndLoginCheck 
        End If 
     
        .MoveFirst 
         
    End With 

    '--------------------------------------------- USER SUCCEED 
    ' show as logged in 
    LoggedIn = True 

    ' do other stuff like retrieve user's security level here 

```

Another

```auto

'================================================== 
' These Routines are lightweight security routines 
' they are NOT strong, but just keep out nosey people 
' by Mark R Hamner (maxhamner (aht) hotmail (daught) com) 
'================================================== 
Public Function SEC_EncryptOnly(ByVal mystring As String, Optional ByVal myseed As String) As String 
    'this performs a one-way encryption - good for storing passwords 
    'when you try to log-in, encrypt the submitted password 
    'do a record select kinda like: 
    ' 
    ' select * from Users where username like 'username' and userpass like 'encryptedpw' 
    ' 
    'You will only get a match if the passwords match 
    'this is always better than retrieving the password from a system for compare 
     
    Dim i, c, lastc As Integer 
    Dim charfirst, charrange As Integer 
    Dim strTemp, strTemp2 As String 
     
    strTemp = "" 
    lastc = 0 
     
    'initial encryption for first charcter & seed from WHOLE string 
    For i = 1 To Len(mystring) 
        lastc = lastc Xor Asc(Mid(mystring, i, 1)) 
    Next 
     
    'each character now encrypted as function of seed & character & position 
    For i = 1 To Len(mystring) 
        c = Asc(Mid(mystring, i, 1)) 
        If Len(myseed) > 0 And i < Len(myseed) - 1 Then 
            ' mask char with previous value AND position AND user seed (up to user seed length) 
            c = c Xor i Xor lastc Xor Asc(Mid(myseed, i, 1)) 
        Else 
            ' mask char with previous value AND position 
            c = c Xor i Xor lastc 
        End If 
        'add our encrypted character 
        strTemp = strTemp & Chr(c) 
        'new value is new mask for next character 
        lastc = c 
    Next 
     
    'chracters are scrambled, but contain 'illegal' values, and I want to be able to 
    'save it in a text file, etc, or not have conflict when I build a compare string, 
    ' so this brings them into a valid range that eliminates the single and double 
    'quotes, making string handling easier. 
    ' 
    'This is NOT done durring the first loop because it would weaken our scramble... 
     
    strTemp2 = "" 
    charfirst = 40 'lowest charcter 40 means no quote 
    charrange = 121 'maximum range (121 possible chracters) 
     
    For i = 1 To Len(strTemp) 
        c = Asc(Mid(strTemp, i, 1)) 
        c = c Mod (charrange - charfirst) 'truncate to chracter range 
        c = c + charfirst 'bump up to lowest char 
        strTemp2 = strTemp2 & Chr(c) 
    Next 
     
    SEC_EncryptOnly = strTemp2 
     
End Function

```