Changing the Screensaver

[davidb]

Using VB 6, anyone have any ideas of how to change the active screensaver to a different one?

[Mark Sreeves]

It's in the registry under the key:


[HKEY_CURRENT_USER\Control Panel\Desktop]
"SCRNSAVE.EXE"="C:\\winnt\\System32\\ssmyst.scr"


You could change this value using registy functions

[Netfox]

It's in WIN NT,how about win9x?

[davidb]

I have tried changing the registry entry, and also changing the SYSTEM.INI entry as well. Neither seems to have any effect, even after I do a reboot.

Any other ideas.....anyone?

[Mark Sreeves]

this works on my NT machine:

form code

Option Explicit

Private Sub Command1_Click()
CommonDialog1.ShowOpen
SaveValue "Desktop", "SCRNSAVE.EXE", CommonDialog1.FileName
End Sub

Private Sub Form_Load()

End Sub

module code

som of this may not be needed as I hacked it out of a larger .bas file

Option Explicit

  Public Const ROOT_REG_KEY As String = "Control Panel\"

  Public Const HKEY_CLASSES_ROOT = &H80000000
  Public Const HKEY_LOCAL_MACHINE = &H80000002
  Public Const HKEY_CURRENT_USER = &H80000001
  
  Public Const REG_SZ = 1                         '  null terminated string
  Public Const INVALID_HANDLE_VALUE = -1
  Public Const ERROR_SUCCESS = 0&
  Public Const KEY_QUERY_VALUE = &H1
  Public Const KEY_SET_VALUE = &H2
  Public Const KEY_CREATE_SUB_KEY = &H4
  Public Const KEY_ENUMERATE_SUB_KEYS = &H8
  Public Const KEY_NOTIFY = &H10
  Public Const KEY_CREATE_LINK = &H20
  Public Const SYNCHRONIZE = &H100000
  Public Const STANDARD_RIGHTS_ALL = &H1F0000
  Public 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))

  Public Const MY_GENERAL_ACCESS = KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS
  Public Const ERROR_NO_MORE_ITEMS = 259&
  Public Const SRCCOPY = &HCC0020

  ' System registry functions
  Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
  Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  Public 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
  Public Declare Function RegQueryValueExStr Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  Public 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
  Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

  Public Function OpenRegKey(ByVal Root As Long, ByVal Path As String) As Long
    ' Open the specified registry key and return the key.
    '
    ' @param:  Root - The key of an open root branch
    ' @param:  Path - The path to the branch to open
    '

    ' Set the error handler
    On Error Resume Next

    Dim MyRegKEy As Long
    If RegOpenKeyEx(Root, Path, 0, MY_GENERAL_ACCESS, MyRegKEy) = ERROR_SUCCESS Then
      OpenRegKey = MyRegKEy
    Else
      OpenRegKey = INVALID_HANDLE_VALUE
    End If
  End Function

  Public Sub CloseRegKey(ByRef regKey As Long)
    ' Close the registry key
    '

    ' Set the error handler
    On Error Resume Next

    If IsValidHandle(regKey) Then
      RegCloseKey (regKey)
      regKey = INVALID_HANDLE_VALUE
    End If
  End Sub
    Public Function IsValidHandle(ByVal Handle As Long) As Boolean
    ' Check a handle to see if it is valid
    '
    ' @return: Boolean indication of a valid hanndle
    '

    ' Set the error handler
    On Error Resume Next

    IsValidHandle = Not (Handle = INVALID_HANDLE_VALUE)
  End Function

  Public Function ReadRegValue(ByVal Key As Long, ByVal ValueName As String) As String
    ' Read a value out of the registry
    '

    ' Set the error handler
    On Error Resume Next

    Dim Buffer As String
    Dim Length As Long
    Length = 255
    Buffer = String(Length, vbNullChar)
    If RegQueryValueExStr(Key, ValueName, 0, REG_SZ, Buffer, Length) = ERROR_SUCCESS Then
      ReadRegValue = Left(Buffer, Length - 1)
    Else
      ReadRegValue = ""
    End If
  End Function

  Public Sub WriteRegValue(ByVal Key As Long, ByVal ValueName As String, ByVal Data As String)
    ' Write a value into the registry
    '

  

    ' Get the length of the data and append a null terminator
    Dim Length As Long
    Length = Len(Data) + 1
    Data = Data & vbNullChar

    ' Set the value
    If RegSetValueEx(Key, ValueName, 0, REG_SZ, ByVal Data, Length) <> ERROR_SUCCESS Then
     MsgBox "Unable to set registry value"
    End If


  End Sub


Public Function GetValue(Section As String, Key As String, Optional Default = "") As String
    On Error Resume Next
    
 ' Add the value by finding it in the system registry
    Dim regKey As Long
    Dim retval As String
    ' Open the registry
    regKey = OpenRegKey(HKEY_LOCAL_MACHINE, ROOT_REG_KEY & Section)
    'Debug.Print "Reading reg for "; Key
    ' Get the value and return it
    retval = ReadRegValue(regKey, Key)
   
  If retval = "" Then
  retval = Default
  End If
    ' Close the registry
  CloseRegKey (regKey)
GetValue = retval
End Function
Public Sub SaveValue(Section As String, Key As String, setting As String)
On Error Resume Next
 ' Open the registry
    Dim regKey As Long
    regKey = OpenRegKey(HKEY_CURRENT_USER, ROOT_REG_KEY & Section)

    ' Set the value
    WriteRegValue regKey, Key, setting

    ' Close the registry
    CloseRegKey (regKey)

End Sub

[omarswan]

Hi,
Does Anyone know the codes required to activate the current screen saver. And also how to tell if a screen saver was set.

[Mark Sreeves]

this activates the current screen saver

Option Explicit

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wPara As Long, ByVal lParam As Long) As Long
    Const WM_SYSCOMMAND = &H112&
    Const SC_SCREENSAVE = &HF140&


Private Sub Command1_Click()
    Dim result As Long
    result = SendMessage(Form1.hWnd, WM_SYSCOMMAND, _
     SC_SCREENSAVE, 0&)

End Sub