Snippet Library

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

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;