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