Not a Member Yet,
Click here to Register
How do you like the new design?
It's cool, great job
[tally: 70%] 70%
It's okay
[tally: 20%] 20%
Its OK but I liked the old layout better
[tally: 0%] 0%
Please bring the old one back
[tally: 10%] 10%

votes: 10

ID: 394
Viewed: 2866
Added: Aug 19, 2002
Version:
Snippet uploaded by: snippet
Written By: Unknown
Demo: Sorry, no demo



User Rated at: 0 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

During a beta test of one of my screen savers, a beta tester pointed out that I was using my own password protection scheme. My method differs from the scheme used in the screen savers that come with Windows. That beta tester wanted me to use the same password as the Windows screen savers. This is a great idea. This means that the user does not have to remember two different passwords.

After some digging, I found some C code that handled the encryption. Here’s a Visual Basic version of it!


Compatible with:
Visual Basic 3, Visual Basic 4 16-bit

Highlight all by clicking in box
<!---Declaration--->
To check To see If the user entered the same 'password that's in the CONTROL.INI file, just 'call the
EncryptPassWord Function:

If EncryptPassWord(txtPassWord(0).Text) = sGetPassWord() Then

'Your Code Goes Here

End If

'To write a new password into CONTROL.INI, just 'call the SavePassWord function:

Call SavePassWord(EncryptPassWord(txtPassWord(2).Text))
''''''''''''''
'Declare
'''''''''''''
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal NewString As String, ByVal filename As String) As Integer

Declare Function GetPrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal default As String, ByVal ReturnedString As String, ByVal MAXSIZE As Integer, ByVal filename As String) As Integer

Highlight All
<!---Code--->
Function sGetPassWord () As String

Dim sTempPass As String

sTempPass = sReadINI("ScreenSaver", "Password", "control.ini")

sGetPassWord = sTempPass

End Function

Sub SavePassWord (sPassWord As String)

Dim R As Integer
Call WriteINI("ScreenSaver", "Password", sPassWord, "control.ini")

End Sub

Function sEncryptPassWord (ByVal sArg As String) As String

Dim iArgPt As Integer

Dim iArgChar As Integer

Dim iArgLen As Integer
iArgLen = Len(sArg)
If iArgLen = 0 Then

Exit Function' Nothing to check

End If


sArg = UCase$(sArg)

'First Pass

For iArgPt = 1 To iArgLen

iArgChar = Asc(Mid$(sArg, iArgPt, 1))

Call PassXor(iArgLen, iArgChar)

If iArgPt = 1 Then

Call PassXor(42, iArgChar)

Else

Call PassXor(iArgPt - 1, iArgChar)

Call PassXor(Asc(Mid$(sArg, iArgPt - 1)), iArgChar)

End If

Mid$(sArg, iArgPt, 1) = Chr$(iArgChar)

Next iArtPt


'Second Pass

If iArgLen > 1 Then

For iArgPt = iArgLen To 1 Step -1

iArgChar = Asc(Mid$(sArg, iArgPt, 1))

Call PassXor(iArgLen, iArgChar)

If iArgPt = iArgLen Then
Call PassXor(42, iArgChar)

Else

Call PassXor(iArgPt - 1, iArgChar)

Call PassXor(Asc(Mid$(sArg, iArgPt + 1, 1)), iArgChar)

End If

Mid$(sArg, iArgPt, 1) = Chr$(iArgChar)

Next iArtPt

End If

sEncryptPassWord = sArg

End Function



Sub PassXor (x1 As Integer, x2 As Integer)

Select Case x2 Xor x1

Case 0 To 32, 127 To 144, 147 To 159, 61, 91, 93

' not allowed

Case Else
x2 = x2 Xor x1

End Select

End Sub



Function sReadINI (sAppName As String, sKeyName As String, sFilename As String) As String

Dim sReturn As String

sReturn = String(255, Chr(0))

sReadINI = Left(sReturn, GetPrivateProfileString(sAppName, ByVal sKeyName, "", sReturn, Len(sReturn), sFilename))

End Function


Sub WriteINI (sAppName As String, sKeyName As String, sNewString As String, sFilename As String)

Dim R As Integer

R = WritePrivateProfileString(sAppName, _

sKeyName, sNewString, sFilename)

End Sub;


No Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.


Replying to a Comment...


Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 snippetlibrary.com All Rights Reserved. Conditions