Visual Basic > Windows and Controls

Get the default screensaver (w95-98-nt)

Get the default screensaver (w95-98-nt)

Prb: find the default screensaver

There is a difference between the way you have to find the default screensaver for Windows NT 
and Windows 95/98.

For NT all relevant settings are located in the registry under the key:


HK_CURRENT_USER\Control Panel\DeskTop\

SCRNSAVE.EXE		= the location and name of the default screensaver
ScreenSaverIsSecure	= if the password setting is set
ScreenSaveActive	= if the screensaver is active


For Windows 95/98 the settings are under:

HK_CURRENT_USER\Control Panel\DeskTop

ScreenSaveActive	= if the screensaver is active
ScreenSaveUsePassword	= if the password setting is set

The name and location are still in the SYSTEM.INI file:

SCRNSAVE.EXE		= the location and name of the default screensaver


You have to check the value of SCRNSAVE.EXE. If it is empty then no screensaver is installed. 
If not you also have to check the value of ScreenSaveActive. It's possible a screenscaver is 
installed but later set to inactive. Not always the setting of SCRNSAVE.EXE is removed.

So before you can get the screensaver you need to know which operating system is running. 
Depending on the result you read the proper keys in the registry and/or read the SYSTEM.INI file.
When you have collected the values you can set the code for starting the screensaver.

You need some API calls:

- common calls and constants

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetProfileString Lib "kernel32" alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize 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

Const ERROR_SUCCESS = 0&
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const KEY_ALL_CLASSES As long = &HF0063

Const REG_SZ As long = 1
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_DYN_DATA = &H80000006
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_USERS = &H80000003

Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private lngResult As Long
Private Const strNT As String = "Windows NT"
Private Const strW95 As String = "Windows 95/98"
Private Const strW32s As String = "Windows 32s"

- getting the running operating system:

Public Function GetOperatingSystem() As String
 ' Get operating system and version.
    dim verinfo As OSVERSIONINFO
    dim lngResult As Long
    verinfo.dwOSVersionInfoSize = Len(verinfo)
    lngResult = GetVersionEx(verinfo)
    If lngResult = 0 Then
        GetOperatingSystem = "UnKnown"
        Exit Function
    end If
    select case verinfo.dwPlatformId
    case 0
        GetOperatingSystem = strW32s
    case 1
        GetOperatingSystem = strW95
    case 2
        GetOperatingSystem = strNT
    end Select
End Function

- getting the Registry settings:

Public Function RegGetString(hInkey As Long, ByVal subkey As String, ByVal valname As String) As String
    dim RetVal As String
    dim hSubKey As Long
    dim dwType As Long
    dim SZ As Long
    dim v As String
    dim r As Long
    
    RetVal = ""
    
    r = RegOpenKeyEx(hInkey, subkey$, 0, KEY_ALL_ACCESS, hSubKey)
    If r <> ERROR_SUCCESS Then GoTo Quit_Now
    SZ = 256: v$ = String$(SZ, 0)
    r = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ)
    If r = ERROR_SUCCESS And dwType = REG_SZ Then
        RetVal$ = Left(v$, SZ - 1)
    Else
        RetVal$ = ""
    end If
    If hInkey = 0 Then r = RegCloseKey(hSubKey)
Quit_Now:
    RegGetString$ = RetVal$

End Function

- getting the SYSTEM.INI setting:

Public Function GetProfileSetting(ByRef AppName As String, ByRef KeyName As String) As String
    dim lngResult As Long
    dim strResult As String
    dim pos As Integer
    '
    strResult = String(254, " ")
    lngResult = GetPrivateProfileString(AppName, KeyName, 0, strResult, Len(strResult), "system.ini")
    If lngResult = 0 Then
        GetProfileSetting = ""
    Else
        'pos = InStr(strResult, vbCrLf)
        strResult = Trim(strResult)
        GetProfileSetting = Left(strResult, Len(strResult) - 1)
    end If
End Function


- making it all work together:

Public Function GetDefaultScreenSaver() As String
    select case GetOperatingSystem
    case strNT
        GetDefaultScreenSaver = RegGetString(&H80000001, "Control Panel\DeskTop", "SCRNSAVE.EXE")
    case strW32s
        GetDefaultScreenSaver = ""
    case strW95
        GetDefaultScreenSaver = GetProfileSetting("boot", "scrnsave.exe")
    end Select
    
End Function


Oke that's all... now how to use it in a VB application.

Suppose you want to make option to hide the current screen. The simplest way to do so is to add a button (a command button or toolbar or even set the code in the form_doubleclick event). Then you have to add the following lines:

Public Sub RunDefaultScreenSaver()
    dim lngResult As Long
    dim strScreenSaver As String
    '
    strScreenSaver = GetDefaultScreenSaver
    If Len(strScreenSaver) <> 0 Then
        strScreenSaver = strScreenSaver + " /s"
        lngResult = Shell(strScreenSaver, vbNormalFocus)
    Else
        Call MsgBox("There is no screensaver installed on this system.", vbOKOnly, App.EXEName)
    end If
End Sub


Return