Option Explicit
'Module level code.
'Toggle the Screensaver on-off
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Long, _
ByVal fuWinIni As Long) As Long
Private Const SPI_SETSCREENSAVEACTIVE = 17
'Registry APIs.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 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 RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'Registry manipulation
Public Const HKEY_CURRENT_USER = &H80000001
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_SET_VALUE = &H2
Private Const REG_SZ = 1
Private Const ERROR_SUCCESS = 0&
Public Sub modWriteRegSZ(lngHKey As Long, strSubKey As String, strValueName As String, _
strValue As String)
'Create the key and respective REG_SZ value.
Dim lngRetVal As Long
Dim lngKeyHandle As Long
'Create the key.
If RegCreateKeyEx(lngHKey, strSubKey, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY, _
ByVal 0&, lngKeyHandle, lngRetVal) <> ERROR_SUCCESS Then GoTo WRITE_SZ_ERROR
'Open the new key.
If RegOpenKeyEx(lngHKey, strSubKey, 0&, KEY_SET_VALUE, lngKeyHandle) <> _
ERROR_SUCCESS Then GoTo WRITE_SZ_ERROR
'Create a key and set its value.
If RegSetValueEx(lngKeyHandle, strValueName, 0&, REG_SZ, ByVal strValue, Len(strValue) + 1) _
<> ERROR_SUCCESS Then GoTo WRITE_SZ_ERROR
'Close the key.
Call RegCloseKey(lngKeyHandle)
'Exit.
Exit Sub
WRITE_SZ_ERROR:
'Close the key.
Call RegCloseKey(lngKeyHandle)
'Time for any error handling.
MsgBox "Error in modWriteRegSZ"
End Sub
Public Sub ScreenSaver_Toggle(Active As Boolean)
'To Activate Screen Saver, set active to true.
'To deactivate, set active to false.
Dim lActiveFlag As Long
lActiveFlag = IIf(Active, 1, 0)
Call SystemParametersInfo SPI_SETSCREENSAVEACTIVE, lActiveFlag, 0, 0
End Sub