Check-in [728576f7a4]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added units for setup of screen saver.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 728576f7a4ff86309ed53bd906c6dfff7c82747d
User & Date: MCO 2014-09-03 15:30:55
Context
2014-09-03
15:31
Added units necessary for setup. check-in: 5f28379b23 user: MCO tags: trunk
15:30
Added units for setup of screen saver. check-in: 728576f7a4 user: MCO tags: trunk
15:14
First checkin, with basic project. check-in: 7ee390566f user: MCO tags: trunk
Changes

Added src/F_Config.dfm.



































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
object frmConfig: TfrmConfig
  Left = 0
  Top = 0
  Caption = 'frmConfig'
  ClientHeight = 282
  ClientWidth = 418
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
end

Added src/F_Config.pas.

















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
unit F_Config;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TfrmConfig = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmConfig: TfrmConfig;

implementation

{$R *.dfm}

end.

Changes to src/F_Main.dfm.

9
10
11
12
13
14
15

16
17
18
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False

  PixelsPerInch = 96
  TextHeight = 13
end







>



9
10
11
12
13
14
15
16
17
18
19
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
end

Added src/ScreenSaverUtils.pas.

















































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
unit ScreenSaverUtils;
{
  Screen Saver Utility Unit
  by Corbin Dunn
  cdunn@borland.com
  Delphi Developer Support
}

interface

uses SysUtils, Windows;

type
  TScreenSaverMode = (ssPassword, ssPreview, ssConfigure, ssRun);
var
  ScreenSaverMode: TScreenSaverMode;
  ParentSaverHandle: THandle = 0;

procedure SetScreenSaverMode;
procedure SetScreenSaverPassword; // Calls Halt - doesn't return
function PromptIfPasswordNeeded(ParentHandle: THandle): Boolean;

implementation

uses Registry;

const
  cApplicationName = 'Random Images Screen Saver';

procedure SetScreenSaverMode;
{
  Find the command line switch to set the screen saver mode.
  Switches can be upper or lower case, preceded by /, -, or nothing.
  Some have a number separated either by a space or a colon.

  (none)  - show configuration dialog with no parent window
            (this is what is done when you double click on a .scr file).
  /c      - config dialog with GetForegroundWindow() as parent
  /c #    - config dialog with # as parent
  /s      - run as full-screen saver
  /p #    - show preview within window whose handle is #
  /l #    - same as /p #
  /a #    - show password dialog as child of #
}
var
  Param: string;
begin
  ScreenSaverMode := ssConfigure;
  if ParamCount > 0 then
  begin
    Param := LowerCase(ParamStr(1));
    if Length(Param) > 1 then
      if Param[1] = '/' then
        Delete(Param, 1, 1);
    if Length(Param) > 1 then
      if Param[1] = '-' then
        Delete(Param, 1, 1);
    case Param[1] of
      'c': ScreenSaverMode := ssConfigure;
      's': ScreenSaverMode := ssRun;
      'p': ScreenSaverMode := ssPreview;
      'l': ScreenSaverMode := ssPreview;
      'a': ScreenSaverMode := ssPassword;
    end;
    // Find out if a handle was passed
    if (Length(Param) > 2) and (Param[2] = ':') then
      Delete(Param, 1, 2)
    else if ParamCount > 1 then
      Param := ParamStr(2);
    try
      ParentSaverHandle := StrToInt(Param);
    except
      ParentSaverHandle := 0;
    end;
  end;
  if ScreenSaverMode = ssPassword then
    SetScreenSaverPassword; // Call's halt
end;

procedure SetScreenSaverPassword;
var
  SysDir: string;
  MyMod: THandle;
  PwdFunc: function(a : PChar; ParentHandle: THandle; b, c: Integer):
    Integer; stdcall;
begin
  SetLength(SysDir, MAX_PATH);
  SetLength(SysDir, GetSystemDirectory(PChar(SysDir), MAX_PATH));
  if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then
    SysDir := SysDir+'\';
  MyMod := LoadLibrary(PChar(SysDir + 'MPR.DLL'));
  try
    if MyMod <> 0 then
    begin
      try
        PwdFunc := GetProcAddress(MyMod,'PwdChangePasswordA');
        if Assigned(PwdFunc) then
          PwdFunc('SCRSAVE',StrToInt(ParamStr(2)),0,0)
        else
          raise Exception.Create('Libarary ' + SysDir + 'MPR.DLL does not ' +
            'contain PwdChangePasswordA used to set the password!');
      finally
        FreeLibrary(MyMod);
      end;
    end
    else
      raise Exception.Create('Could not load library ' + SysDir + 'MPR.DLL - ' +
        ' The password cannot be changed');
  except
    on E: Exception do
      MessageBox(ParentSaverHandle, PChar(E.Message), cApplicationName,
        MB_OK or MB_ICONSTOP)
  end;
  Halt;
end;

function PromptIfPasswordNeeded(ParentHandle: THandle): Boolean;
var
  SysDir: string;
  PwdFunc: function (Parent : THandle) : Boolean; stdcall;
  MyMod: THandle;
begin
  // Return true if we can close
  Result := True;
  with TRegistry.Create do
  try
    if OpenKey('Control Panel\Desktop', False) then
    begin
      if ValueExists('ScreenSaveUsePassword') and
        (ReadInteger('ScreenSaveUsePassword') <> 0) then
      begin
        SetLength(SysDir, MAX_PATH);
        SetLength(SysDir, GetSystemDirectory(PChar(SysDir), MAX_PATH));
        if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then
          SysDir := SysDir + '\';
        MyMod := LoadLibrary(PChar(SysDir+'password.cpl'));
        if MyMod <> 0 then
        try
          PwdFunc := GetProcAddress(MyMod, 'VerifyScreenSavePwd');
          if not PwdFunc(ParentHandle) then
            Result := False;
          FreeLibrary(MyMod);
        except
        end;
      end;
    end;
  finally
    Free;
  end;
end;

end.

Added src/SingleInstance.pas.















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
unit SingleInstance;
{
  Single Instance Unit
  by Corbin Dunn
  cdunn@borland.com
  Delphi Developer Support
}

// Only allow one instance of the screen saver to run at a time.
// Windows tends to start multiple copies of the Screen Saver at
// any time.

interface

procedure FreeMutex;

implementation

uses SysUtils, Forms, Windows;

const
  cRandomString = 'Random Images Screen Saver';
var
  SingleMutex: THandle = 0;

procedure CreateMutexOrDie;
begin
  if OpenMutex(MUTEX_ALL_ACCESS, False, cRandomString) = 0 then
  begin
    // First one - the mutex didn't exist, so create it.
    SingleMutex := CreateMutex(nil, False, cRandomString);
  end
  else
  begin
    // The mutex did exist, so the application is running.
    // Terminate it in this case.
    Application.ShowMainForm := False;
    Application.Terminate;
  end;
end;

procedure FreeMutex;
begin
  if SingleMutex <> 0 then
  begin
    CloseHandle(SingleMutex);
    SingleMutex := 0;
  end;
end;

initialization
  CreateMutexOrDie;
finalization
  FreeMutex;
end.