Screen Saver based on username

I am looking for a way to control a windows screen saver via code.  Basically if certain specified users log in the screen saver will be disabled while it will be left on for others.  But this must be set back to the default when they logoff.  Is there any way to trigger a program at logoff?
Also is there an easier way to change the screen saver than editing one of the ini files in the windows dir?
LVL 1
AikemaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

KhollADCommented:
You can try the code below to make it.

The application must be in Start menu or 'Load=xxxx.exe' in win.ini or in HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run  or in your owner start mechanism.



Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long

Private Const RSP_SIMPLE_SERVICE = 1

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Dim SSaverDefault As String

Private Sub Form_Load()

    'Hides the application from the desktop and task manager to prevents closing.
    Me.Visible = False
    MakeTaskHidden
   
    'Stores the Default Screen Saver
    SSaverDefault = GetCurrentScreenSaver
   
    'Choose the Screen Saver by user
    ChooseSSaverByUser
   
End Sub

Private Sub ChooseSSaverByUser()

    Dim lRet As Long
    Dim UserName As String
    Dim lenght As Long
    Dim i As Integer
   
    UserName = Space(255)
    lenght = 255
   
    lRet = GetUserName(UserName, lenght)
   
    i = InStr(1, UserName, Chr(0))
    If i <> 0 Then
        UserName = Left(UserName, i - 1)
    End If
   
    'Your user choices
    Select Case Trim(UserName)
        Case "MyUser1"
            ChangeScreenSaver "C:\Windows\System\3D Text.scr"
        Case "MyUser2"
            ChangeScreenSaver "C:\Windows\System\SSaver1.scr"
        Case "MyUser3"
            TurnOffScreenSaver
    End Select
   
End Sub


Private Sub ChangeScreenSaver(ByVal file_name As String)

    Dim lRet As Long
    Dim length As Long
    Dim short_path As String

    short_path = Space$(1024)
    length = GetShortPathName(file_name, short_path, Len(short_path))
    short_path = Left$(short_path, length)
   
    lRet = WritePrivateProfileString("boot", "SCRNSAVE.EXE", short_path, "system.ini")

End Sub

Private Sub TurnOffScreenSaver()

    Dim lRet As Long
   
    lRet = WritePrivateProfileString("boot", "SCRNSAVE.EXE", "", "system.ini")

End Sub

Private Function GetCurrentScreenSaver() As String

    Dim lRet As Long
    Dim length As Long
    Dim short_path As String
    Dim i As Integer
   
    short_path = Space(255)
    lenght = 255
   
    lRet = GetPrivateProfileString("boot", "SCRNSAVE.EXE", "", short_path, lenght, "system.ini")
   
    i = InStr(1, short_path, Chr(0))
   
    If i <> 0 Then
        short_path = Left(short_path, i - 1)
    End If
   
    GetCurrentScreenSaver = short_path
   
End Function

Private Sub MakeTaskHidden()

    Dim pId As Long
    Dim lRet As Long
   
    pId = GetCurrentProcessId()
    lRet = RegisterServiceProcess(pId, RSP_SIMPLE_SERVICE)

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   
    'The Trigger
    'If shutdown or restart windows, restore the default screen saver
    If UnloadMode = vbAppWindows Then
        ChangeScreenSaver SSaverDefault
    Else
        Cancel = True
    End If
   
End Sub




I Hope it helps. Any doubts or problems sends a comment.
Kholl.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
AikemaAuthor Commented:
Looking good!!! i've got exams this week so I might not get around to trying it for a few days though
0
AikemaAuthor Commented:
so will the program startup every time a user logs in? ...or just when windows boots up?
0
KhollADCommented:
it depends where you put the application :

If you put the Application in StartUp menu or 'Load=xxx.exe' (Win.ini section) the program will run after the user log in.
If you put the Application in registry HKEY_LOCAL_MACHINE\SOFTWARE\... (this is a secure way, the cases above (startup menu, 'load=' section) are more easy for the user access, leaving a way to the user turn off your app from windows start) the application will run before the user log in, then you need to implemments a loop until the user complete the login :

     
UserName = Space(255)
lenght = 255

dt = Now
'Loop
Do While Trim(UserName) = "" 
    lRet = GetUserName(UserName, lenght)
     
    i = InStr(1, UserName, Chr(0))
    If i <> 0 Then
        UserName = Left(UserName, i - 1)
    End If
    Doevents
    'Wait for 1 minute (a time for the windows load the logon dialog and user enter your login username and password)
    If DateDiff("n", dt, Now) >= 1 Then
       Exit Do
    End If
Loop

Tell me if you want more info and if the code works, and  if you need the code to put the application in these start ways.
0
KhollADCommented:
Thanks !
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.