home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sspw / sspw.bas < prev    next >
Encoding:
BASIC Source File  |  1995-01-13  |  2.0 KB  |  76 lines
  1. Option Explicit
  2. 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 IniFileName As String) As Integer
  3.  
  4. ' This is a simple demo to show how to access the default
  5. ' saver password. To use this in a Screen Saver you'll need
  6. ' to add the routines to check and change the password and
  7. ' save the encrypted password back to Control.Ini
  8.  
  9. ' John Hayward. CIS 100034,320
  10.  
  11. Sub EncryptString (sArg As String)
  12. Dim iArgPt As Integer
  13. Dim iArgChar As Integer
  14. Dim iArgLen As Integer
  15.  
  16.   iArgLen = Len(sArg)
  17.   If iArgLen = 0 Then Exit Sub  ' Nothing to check
  18.   sArg = UCase$(sArg)
  19.  
  20. ' First Pass
  21.   For iArgPt = 1 To iArgLen
  22.     iArgChar = Asc(Mid$(sArg, iArgPt, 1))
  23.     Call PassXor(iArgLen, iArgChar)
  24.     If iArgPt = 1 Then
  25.       Call PassXor(42, iArgChar)
  26.     Else
  27.       Call PassXor(iArgPt - 1, iArgChar)
  28.       Call PassXor(Asc(Mid$(sArg, iArgPt - 1)), iArgChar)
  29.     End If
  30.     Mid$(sArg, iArgPt, 1) = Chr$(iArgChar)
  31.   Next
  32.  
  33. ' Second Pass
  34.   If iArgLen > 1 Then
  35.     For iArgPt = iArgLen To 1 Step -1
  36.       iArgChar = Asc(Mid$(sArg, iArgPt, 1))
  37.       Call PassXor(iArgLen, iArgChar)
  38.       If iArgPt = iArgLen Then
  39.         Call PassXor(42, iArgChar)
  40.       Else
  41.         Call PassXor(iArgPt - 1, iArgChar)
  42.         Call PassXor(Asc(Mid$(sArg, iArgPt + 1, 1)), iArgChar)
  43.       End If
  44.     Mid$(sArg, iArgPt, 1) = Chr$(iArgChar)
  45.     Next
  46.   End If
  47.  
  48. End Sub
  49.  
  50. Function GetPassword () As String
  51. Dim iret%
  52. Dim PW As String * 25
  53.  
  54.   PW = Space$(25)
  55.   iret% = GetPrivateProfileString("ScreenSaver", "Password", "", PW, 25, "Control.Ini")
  56.   If iret% <= 0 Then
  57.     MsgBox "Couldn't Read the Password"
  58.     GetPassword = ""
  59.   Else
  60.     GetPassword = Left$(PW, iret%)
  61.   End If
  62.  
  63. End Function
  64.  
  65. Sub PassXor (x1 As Integer, x2 As Integer)
  66.  
  67.   Select Case x2 Xor x1
  68.     Case 0 To 32, 127 To 144, 147 To 159, 61, 91, 93
  69.       ' not allowed
  70.     Case Else
  71.       x2 = x2 Xor x1
  72.   End Select
  73.  
  74. End Sub
  75.  
  76.