Using VB 6, anyone have any ideas of how to change the active screensaver to a different one?
Printable View
Using VB 6, anyone have any ideas of how to change the active screensaver to a different one?
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
It's in WIN NT,how about win9x?
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?
this works on my NT machine:
form code
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
Code:
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
Hi,
Does Anyone know the codes required to activate the current screen saver. And also how to tell if a screen saver was set.
this activates the current screen saver
Code: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