Random Screensaver for windows

This screensaver randomly chooses screensavers when it starts. You can choose which folders to use, how long of a delay between screensavers and which ones you don’t want running.

program randomss;
{$RESOURCE RANDOMSCREENSAVER.RES}
(*
  This is the main file for random screensaver
  it starts the configuration window (TScreenSaverConfig)
  it starts choosing screensavers.
*)
uses
  SysUtils,
  windows,
  Classes,
  filectrl,
  forms,
  graphics,
  shellapi,
  randomssUnit1 in 'randomssUnit1.pas' {ScreenSaverConfig};
{$E scr}
label nextscr;
const RUNNING_HINT:pchar='Delete this key to allow the screensaver to run again';
type
TGetProcessId=function(handle:THandle):DWord;stdcall;
//The function GetProcessId wasn't defined in Delphi 4
var
hkRunning:hkey;
screc,scrpid:dword;
I:integer;
used:tstringlist;
exec:shellexecuteinfo;
preview:TCanvas;
GetProcessId:tgetprocessid;
previewRect:TRect;
randomized:boolean;
dir:array[0..max_path]of char;
Icon:TIcon;

function AlreadyRunning:boolean;
var disp,pid:dword;
hkrunning:hkey;
begin
disp:=maxdword;
pid:=getcurrentprocessid;
regcreatekeyex(hkey_current_user,reg_running,0,nil,reg_option_volatile,key_write,
nil,hkrunning,@disp);regsetvalueex(hkrunning,nil,0,reg_sz,running_hint,(1+strlen(
running_hint))*sizeof(char));
result:=(disp=reg_opened_existing_key);
if not result then regsetvalueex(hkrunning,reg_processid,0,reg_dword,@pid,4);
regclosekey(hkrunning);
end;

begin
randomize;
regcreatekeyex(hkey_current_user,'Software\Justin\RandomSCR',0,nil,
reg_option_non_volatile,key_all_access,nil,hkapp,nil);
bRunOnce:=(regqueryvalueex(hkapp,reg_norunonce,nil,nil,nil,nil)<>error_success);
rs:=4;
bnoshuffle:=(regqueryvalueeX(hkapp,reg_randomseed,nil,nil,@randseed,@rs)=error_success);
rs:=4;
getwindowsdirectory(windir,max_path);
maxtime:=60000;
regqueryvalueex(hkapp,reg_runtime,nil,nil,@maxtime,@rs);
randomized:=(maxtime=random_time);
rs:=sizeof(szExcluded);
regqueryvalueeX(hkapp,reg_excluded,nil,nil,Pointer(strcopy(szexcluded,'')),@rs);
excluded:=tstringlist.Create;
excluded.CommaText:=strpas(szexcluded);
excluded.Append(paramstr(0));
directories:=tstringlist.create;
rs:=sizeof(szdirectories);
directories.Append(windir);//for windows 9x/Me(Even though  this tool won't work with that OS)
if directoryexists(strfmt(dir,'%s\system32',[windir]))then directories.Append(
dir);//for NT-type screensavers
if directoryexists(strfmt(dir,'%s\SysWOW64',[windir]))then directories.Append(
dir);//for 64-bit windows
if directoryexists(strfmt(dir,'%s\system',[windir]))then directories.Append(dir);
//just in case there screensavers in that folder
regqueryvalueex(hkapp,reg_dirlist,nil,nil,pointer(strplcopy(szDirectories,
directories.commatext,1024)),@rs);
directories.commatext:=strpas(szdirectories);
screensavers:=tstringlist.Create;
for i:=0to directories.count-1do begin
if findfirst(format('%s\*.scr',[directories[i]]),faanyfile,findscr)=0then begin
if(excluded.IndexOf(findscr.finddata.cfilename)=-1)and(-1=excluded.Indexof(
extractfilename(findscr.FindData.cFileName))) then
screensavers.Append(Directories[i]+'\'+findscr.FindData.cFileName);
while findnext(findscr)=0do
if(excluded.IndexOf(findscr.finddata.cfilename)=-1)and(-1=excluded.Indexof(
extractfilename(findscr.FindData.cFileName))) then
screensavers.Append(directories[i]+'\'+findscr.FindData.cFileName);
sysutils.FindClose(findscR);
end;
end;
if(comparetext('/p',paramstr(1))<>0)and(comparetext(paramstr(1),'/s')<>0)and(
comparetext('/debug',paramstr(1))<>0)then
begin(* This code is executed when the Settings button has been clicked or
        Configure has been choosen from the file menu *)
application.Initialize;
Application.CreateForm(Tscreensaverconfig, screensaverconfig);
application.Run;
exitprocess(0);
end;
regclosekey(hkapp);
if comparetext('/p',paramstr(1))=0then
begin(* executes this code when being previewed in control panel *)
icon:=ticon.Create;
icon.Handle:=loadicon(hinstance,MakeIntResource(1));
preview:=tcanvas.Create;
preview.Handle:=getwindowdc(strtoint(paramstr(2)));
getclientrect(strtoint(paramstr(2)),previewrect);
while iswindow(strtoint(paramstr(2)))do
begin
for I:=0to high(randomss_about)do
preview.TextOut(0,i*16,randomss_about[i]);
with previewrect.BottomRight do
preview.Draw(x div 2,y div 2,icon);//draw the icon in the middle of the preview window
sleep(100);
end;
releasedc(strtoint(paramstr(2)),preview.handle);
exitprocess(0);
 end;
 if alreadyrunning then exitprocess(wait_timeout);
 //Don't allow more than one process of this screensaver running.
 @GetProcessId:=getprocaddress(getmodulehandle(kernel32),'GetProcessId');
 zeromemory(@exec,sizeof(exec));
exec.cbSize:=sizeof(exec);
exec.fMask:=see_mask_nocloseprocess;
exec.lpFile:=stralloc(MAX_PATH+1);
exec.lpParameters:='/S';
exec.nShow:=sw_show;
if screensavers.Count=0then begin messagebox(0,'No screensavers found',appname,
mb_iconwarning);exitprocess(error_file_not_found);end;
used:=tstringlist.Create;
(* Starts choosing screensavers *)
regopenkeyex(hkey_current_user,reg_running,0,key_all_access,hkrunning);
(*Assumes that the key "HKEY_CURRENT_USER\Software\Justin\RandomSCR\Running" exists
  or created by the alreadyrunning function *)
nextscr:if randomized then maxtime:=60000+random(15*60000);
if used.Count=screensavers.Count then used.Clear;
if(used.IndexOf(strpcopy(exec.lpFile,screensavers[random(screensavers.count)]))>-1)
then goto nextscr;
if brunonce then used.Append(exec.lpFile);
if not shellexecuteex(@Exec) then(* Use ShellExecuteEx to start the screensaver *)
begin regclosekey(hkrunning);exitprocess(1);end;
if assigned(getprocessid)then scrpid:=getprocessid(exec.hProcess);
regsetvalueex(hkrunning,reg_scrpid,0,reg_dword,@scrpid,4);
case waitforsingleobject(exec.hProcess,maxtime)of(* wait for timeout or screensaver exit *)
wait_timeout:begin terminateprocess(exec.hProcess,0);closehandle(exec.hProcess);
goto nextscr; end;
wait_failed:messagebox(0,pchar('WaitForScreensaver: '+syserrormessage(
getlasterror)),exec.lpfile,mb_iconwarning);
else screc:=0;getexitcodeprocess(exec.hprocess,screc);terminateprocess(
exec.hProcess,0);closehandle(exec.hProcess);if screc=wait_timeout then
goto nextscr;
end;
if hkrunning<>0then regclosekey(hkrunning);
regdeletekey(hkey_current_user,reg_running);
exitprocess(getlasterror);
end.

unit randomssUnit1;
(*
  Settings form unit.
*)
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ComCtrls;
const appname='Random Screensaver';
REG_RUNNING='Software\Justin\RandomSCR\Running';
reg_runtime='RunTime';
reg_excluded='Excluded';
reg_processid='ProcessID';
reg_scrpid='SCRProcessID';
random_time=maxdword-1;
RandomSS_About:Array[0..2]of string=(
'delphijustin Random ScreenSaver v1.0',
'By Justin Roeder','2021');
reg_dirlist='Directories';
reg_randomseed='RandomSeed';
reg_NoRunOnce='NoRunOnce';
type
EBadTimeout=class(Exception)
end;
  TScreenSaverConfig = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Button1: TButton;
    MainMenu1: TMainMenu;
    Help1: TMenuItem;
    About1: TMenuItem;
    Button2: TButton;
    Label3: TLabel;
    Memo2: TMemo;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    CheckBox1: TCheckBox;
    Label4: TLabel;
    StatusBar1: TStatusBar;
    ComboBox1: TComboBox;
    CheckBox2: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure About1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
function StrToTimeout(const s:string):dword;
var
  ScreenSaverConfig: TScreenSaverConfig;
  bRunOnce,bNoShuffle:boolean;
maxTime,rs:dword;
ScreenSavers,excluded,directories:Tstringlist;
findscr:tsearchrec;
windir:array[0..max_path]of char;
szdirectories,szExcluded:array[0..1024]of char;
hkApp:hkey;
implementation

{$R *.DFM}

function TimeoutToStr(timeout:dword):string;
begin
case timeout of //Converts the timeout(in milliseconds)to a readable string
infinite:result:='INF';
RANDOM_TIME:result:='RANDOM';
ELSE result:=formatdatetime('hh:mm:ss',timeout*EncodeTime(0,0,0,1));
END;
end;

function StrToTimeout(const s:string):dword;
begin
try//does the opposite of TimeoutToStr
if comparetext(s,'INF')=0then result:=infinite else
if comparetext(s,'RANDOM')=0Then result:=random_time else
result:=round(strtotime(s)/encodetime(0,0,0,1));
if(result<60000)then
raise EBadTimeout.Create(
'To prevent system crashes, the time cannot be less than 1 minute');
except on E:EConvertError do result:=60000;end;
end;

procedure TScreenSaverConfig.FormCreate(Sender: TObject);
begin//initializes the configuration form.
regdeletekey(hkey_current_user,reg_running);
with excluded do delete(indexof(paramstr(0)));
icon.Handle:=loadicon(hinstance,makeintresource(1));
application.Icon.Handle:=icon.Handle;
application.Title:=caption;
opendialog1.InitialDir:=strpas(windir);
checkbox1.Checked:=brunonce;
checkbox2.Checked:=bNoShuffle;
combobox1.Text:=timeouttostr(maxtime);
memo1.Text:=directories.Text;
memo2.Text:=excluded.text;
statusbar1.SimpleText:=format(statusbar1.SimpleText,[screensavers.count]);

end;

procedure TScreenSaverConfig.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
regclosekey(hkapp);
exitprocess(0);
end;

procedure TScreenSaverConfig.About1Click(Sender: TObject);
var msgbox:msgboxparams;
I:integer;
begin
zeromemory(@msgbox,sizeof(msgboX));
msgbox.cbSize:=sizeof(msgbox);
msgbox.hwndOwner:=handle;
msgbox.hInstance:=hinstance;
msgbox.lpszText:=strcopy(stralloc(2048),'');
for I:=0to high(randomss_about)do
strpcopy(strend(msgbox.lpsztext),randomss_about[i]+#13#10);
msgbox.lpszCaption:='About';
msgbox.dwStyle:=mb_usericon;
msgbox.lpszIcon:=makeintresource(1);
messageboxindirect(msgbox);
strdispose(msgbox.lpszText);
end;

procedure TScreenSaverConfig.Button1Click(Sender: TObject);
begin
(* Saves settings in the registry under the following key:
   HKEY_CURRENT_USER\Software\Justin\RandomSCR
   NoRunOnce         If exists the screensaver list wont act like a deck of cards.
   Excluded          Comma seperated list of screensavers to not run.
   Directories       Comma seperated list of screensaver directories
   RandomSeed        If exists the list won't be shuffled and its seed is initialed by that value.
   RunTime           Timeout in milliseconds or one of the following values:
                     0xFFFFFFFF Unlimited time
                     0xFFFFFFFE Random time in between(1 and 15 minutes)
*)
if checkbox1.Checked then regdeletevalue(hkapp,reg_norunonce)else
regsetvalueex(hkapp,reg_norunonce,0,reg_binary,nil,0);
maxtime:=strtotimeout(combobox1.text);
with memo2.Lines do
regsetvalueex(hkapp,reg_excluded,0,reg_sz,strpcopy(szExcluded,commatext),(1+
length(commatext))*sizeof(chaR));
regsetvalueex(hkapp,reg_runtime,0,reg_dword,@maxtime,4);
with memo1.Lines do
regsetvalueex(hkapp,reg_dirlist,0,reg_sz,strpcopy(szdirectories,commatext),(1+
length(commatext))*sizeof(char));
if checkbox2.Checked then regsetvalueex(hkapp,reg_randomseed,0,reg_dword,
@randseed,4)else regdeletevalue(hkapp,reg_randomseed);
close;
end;

procedure TScreenSaverConfig.Button2Click(Sender: TObject);
begin
close;
end;

procedure TScreenSaverConfig.Button3Click(Sender: TObject);
begin
(* Exclude list browse button *)
if not opendialog1.Execute then exit;
memo2.Lines.Add(extractfilename(opendialog1.filename));
end;

end.