Mega Code Archive
How to set the current screensaver
<![CDATA[
Title: How to set the current screensaver
Question: In my company each user needs to have a screensaver set with a specific timeout period, how can I do this?
Answer:
The following code sets up your desired screensave then shows it. For actual use this code needs to be changed to suite your needs i.e. remove ShowMessage dialogs, change name of screensaver, change timeout value and remove actual testing section.
Tested under Windows XP but should work with earlier versions of Windows
program SetupDefaultScrnSaver;
uses
Windows, SysUtils, Forms, Dialogs, Registry;
const
{ from Windows.pas }
SPI_SETSCREENSAVEACTIVE = 17;
SPIF_SENDWININICHANGE = 2;
SPI_SETSCREENSAVETIMEOUT = 15;
{ from Messages.pas }
WM_SYSCOMMAND = $0112;
{ From Project JEDI JCL library
http://www.delphi-jedi.org/Jedi:CODELIBJCL:22798 }
function GetWindowsSysFolder: string;
procedure StrResetLength(var S: AnsiString);
begin
SetLength(S, StrLen(PChar(S)));
end;
var
Required: Cardinal;
begin
Result := '';
Required := GetSystemDirectory(nil, 0);
if Required 0 then
begin
SetLength(Result, Required);
GetSystemDirectory(PChar(Result), Required);
StrResetLength(Result) ;
end;
end;
function SetScreenSave(const Name: string; Const TimeOut: Integer = 30):Boolean;
const
SixtySeconds = 60 ;
var
Reg:TRegistry ;
begin
if not FileExists(Name) then
begin
ShowMessage('ScreenSaver "' + Name + '" not located') ;
exit ;
end ;
Reg := TRegistry.Create ;
Reg.RootKey := HKEY_CURRENT_USER ;
try
with Reg do
begin
if OpenKey('Control Panel\Desktop',False) then
begin
WriteString('SCRNSAVE.EXE', Name) ;
WriteString('ScreenSaverIsSecure','1') ;
CloseKey ;
end else
begin
Result := False ;
exit ;
end ;
end ;
finally
Reg.Free ;
end ;
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,1,nil,SPIF_SENDWININICHANGE);
SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT,SixtySeconds * TimeOut,
nil,SPIF_SENDWININICHANGE);
Result := True ;
end;
begin
{ -=CHANGE THE SCREENSAVER NAME TO ONE YOU WANT THE USER TO HAVE=- }
if SetScreenSave(GetWindowsSysFolder + '\ss3dfo.scr') then begin
ShowMessage('Screensaver set, press OK to test (remember grace period)') ;
PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
end ;
end.
]]>