WebSVN – alarming – Diff – /trunk/Delphi Client/DoorAlarmClientMain.pas


unit DoorAlarmClientMain;
 
// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected, with different event sounds etc
// TODO: ask server to subscribe/unsubscribe to events (doorbell, motion)
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, HTTPApp, StdCtrls,
  IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,
  JPEG, MJPEGDecoderUnit, IniFiles, Menus;
 
type
  TAlarmType = (atUnknown, atMotion, atDoorbell);
 
  TForm1 = class(TForm)
    Image1: TImage;
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    Open1: TMenuItem;
    Image2: TImage;
    CloseTimer: TTimer;
    UpdateIPTimer: TTimer;
    Allowmutingsoundinterface1: TMenuItem;
    N1: TMenuItem;
    Startalarm1: TMenuItem;
    N2: TMenuItem;
    Stopalarm1: TMenuItem;
    Gotocontrolpanelwebsite1: TMenuItem;
    doorbellPanel: TPanel;
    N3: TMenuItem;
    Ignoredoorbell1: TMenuItem;
    Ignoremotionalert1: TMenuItem;
    unknownAlarm: TPanel;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrayIcon1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure CloseTimerTimer(Sender: TObject);
    procedure UpdateIPTimerTimer(Sender: TObject);
    procedure Startalarm1Click(Sender: TObject);
    procedure Stopalarm1Click(Sender: TObject);
    procedure Gotocontrolpanelwebsite1Click(Sender: TObject);
    procedure ImageClick(Sender: TObject);
  private
    MJPEGDecoder: TMJPEGDecoder;
    LastDingDong: TDateTime;
    SimpleCS: boolean;
    ini: TMemIniFile;
    last_known_webcam_port: integer;
    procedure ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure MotionDetected;
    procedure HandleFrame(Sender: TObject; Frame: TJPEGImage);
    procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
    procedure StartStream;
    procedure StopStream;
    procedure DoShowForm(AlarmType: TAlarmType);
    procedure DoPosition;
    procedure StopMusic;
    function ControlServerUrl: string;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  mmSystem, idhttp, DateUtils, ActiveX, ComObj, AudioVolCntrl, ShellAPI;
 
var
  Server: TIdHTTPServer;
  gShuttingDown: boolean;
 
procedure CallUrl(const url: string);
var
  idhttp: TIdHTTP;
begin
  if url <> '' then
  begin
    idhttp := TIdHTTP.Create(nil);
    try
      idhttp.Get(url);
    finally
      FreeAndNil(idhttp);
    end;
  end;
end;
 
procedure TForm1.Stopalarm1Click(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  try
    try
      lParamList := TStringList.Create;
      lParamList.Add('action=motion_off'); // 1.3.6.1.4.1.37476.2.4.1.101
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  except
    // Nothing
  end;
end;
 
procedure TForm1.StopMusic;
const
  TIMEOUT = 1000; // ms
var
  lpdwResult: DWORD;
begin
  // Stops Spotify, WMP, etc.
  lpdwResult := 0;
  SendMessageTimeout(HWND_BROADCAST, WM_APPCOMMAND, 0, MAKELONG(0, APPCOMMAND_MEDIA_STOP), SMTO_NORMAL, TIMEOUT, lpdwResult);
 
  // Mutes everything (also YouTube)
  if Allowmutingsoundinterface1.Checked then
  begin
    OleCheck(CoInitialize(nil));
    try
      MuteAllAudioDevices(true);
    finally
      CoUninitialize;
    end;
  end;
end;
 
procedure TForm1.HandleFrame(Sender: TObject; Frame: TJPEGImage);
begin
  try
    Image1.Picture.Bitmap.Assign(Frame);
 
    Left := Left + (ClientWidth  - Image1.Picture.Width);
    Top  := Top  + (ClientHeight - Image1.Picture.Height);
 
    ClientWidth := Image1.Picture.Width;
    ClientHeight := Image1.Picture.Height;
  finally
    Frame.Free;
  end;
end;
 
procedure TForm1.ImageClick(Sender: TObject);
(*
var
  pnt: TPoint;
*)
begin
  (*
  if GetCursorPos(pnt) then
    PopupMenu1.Popup(pnt.X, pnt.Y);
  *)
end;
 
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
  gShuttingDown := true;
  Message.Result := 1;
end;
 
procedure TForm1.Startalarm1Click(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  try
    try
      lParamList := TStringList.Create;
      lParamList.Add('action=motion_on'); // 1.3.6.1.4.1.37476.2.4.1.100
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  except
    // Nothing
  end;
end;
 
procedure TForm1.StartStream;
begin
  if last_known_webcam_port = 0 then exit;
 
  MJPEGDecoder.OnFrame := HandleFrame;
  MJPEGDecoder.OnError := nil;
  MJPEGDecoder.OnMessage := nil;
  MJPEGDecoder.Connect(ini.ReadString('Server', 'Address', '127.0.0.1'),
                       last_known_webcam_port,
                       '/');
end;
 
procedure TForm1.StopStream;
begin
  MJPEGDecoder.Disconnect;
end;
 
procedure TForm1.CloseTimerTimer(Sender: TObject);
begin
  CloseTimer.Enabled := false;
  Close;
end;
 
procedure TForm1.MotionDetected;
var
  AlarmSound: string;
  DingDongMinInterval: integer;
begin
  DingDongMinInterval := ini.ReadInteger('Sound', 'AlarmMinInterval', 10);
  if SecondsBetween(Now, LastDingDong) > DingDongMinInterval then
  begin
    LastDingDong := Now;
 
    if ini.ReadBool('Sound', 'StopMusic', true) then
    begin
      StopMusic;
    end;
 
    AlarmSound := ini.ReadString('Sound', 'AlarmSoundFile', '');
    if AlarmSound <> '' then
    begin
      PlaySound(PChar(AlarmSound), 0, SND_ALIAS or SND_ASYNC);
    end;
  end;
end;
 
procedure TForm1.Exit1Click(Sender: TObject);
begin
  gShuttingDown := true;
  Close;
end;
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CloseTimer.Enabled := false;
  CanClose := gShuttingDown;
  if not CanClose then Hide;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
 
  DoubleBuffered := true;
 
  Server := TIdHTTPServer.Create();
  Server.DefaultPort := ini.ReadInteger('Client', 'ListenPort', 80);
  Server.OnCommandGet := ServerCommandGet;
  Server.Active := true;
 
  Gotocontrolpanelwebsite1.Visible := true;
  Startalarm1.Visible := true;
  Stopalarm1.Visible := true;
  N2.Visible := Gotocontrolpanelwebsite1.Visible or Startalarm1.Visible or Stopalarm1.Visible;
 
  MJPEGDecoder := TMJPEGDecoder.Create(Self);
 
  DoPosition;
 
  // Question: Should these settings also be saved for the next program session?
  Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false);
  Ignoredoorbell1.Checked := ini.ReadBool('Client', 'IgnoreDoorbell', false);
  Ignoremotionalert1.Checked := ini.ReadBool('Client', 'IgnoreMotion', false);
 
  UpdateIPTimerTimer(UpdateIPTimer);
  UpdateIPTimer.Interval := ini.ReadInteger('Client', 'SubscribeInterval', 30*60) * 1000;
  UpdateIPTimer.Enabled := true;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(Server) then Server.Active := false;
  FreeAndNil(Server);
 
  FreeAndNil(ini);
 
  FreeAndNil(MJPEGDecoder);
end;
 
procedure TForm1.FormHide(Sender: TObject);
begin
  if Image2.Visible then
    StopStream;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
  if Image2.Visible then
    StartStream;
end;
 
procedure TForm1.Gotocontrolpanelwebsite1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', PChar(ControlServerUrl), '', '', SW_NORMAL);
end;
 
procedure TForm1.Open1Click(Sender: TObject);
begin
  TrayIcon1Click(TrayIcon1);
end;
 
procedure TForm1.ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  AutoCloseTimerInterval: integer;
  AlarmType: TAlarmType;
begin
  aResponseInfo.ResponseNo  := 200;
  aResponseInfo.ContentType := 'text/html';
  aResponseInfo.ContentText := '';
 
  if (ARequestInfo.CommandType = hcPOST) and
     (ARequestInfo.Params.Values['action'] = 'client_alert') then // 1.3.6.1.4.1.37476.2.4.1.3
  begin
    if ARequestInfo.Params.Values['motion_port'] <> '' then
    begin
      TryStrToInt(ARequestInfo.Params.Values['motion_port'], last_known_webcam_port);
    end;
 
    if ARequestInfo.Params.Values['simulation'] = '1' then
    begin
      exit;
    end;
 
    if SimpleCS then exit;
    SimpleCS := true;
    try
      if CloseTimer.Enabled then
      begin
        CloseTimer.Enabled := false;
        CloseTimer.Enabled := true; // "Restart" timer
      end;
 
      AutoCloseTimerInterval := ini.ReadInteger('Client', 'AutoCloseTimer', 5000);
      if (not Visible) and (AutoCloseTimerInterval <> -1) then
      begin
        CloseTimer.Interval := AutoCloseTimerInterval;
        CloseTimer.Enabled := true;
      end;
 
      if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.1002' {camera, motion}) >= 0 then
        AlarmType := atMotion
      else if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.2001' {sound, doorbell}) >= 0 then
        AlarmType := atDoorbell
      else
      begin
        // TODO: Make plugin DLLs ?
        AlarmType := atUnknown;
      end;
 
      // Attention: Ignoring these events at the client does not prevent the server
      // doing other actions (e.g. ask Spotify to stop the music on connected devices)
      if Ignoredoorbell1.Checked and (AlarmType = atDoorbell) then Exit;
      if Ignoremotionalert1.Checked and (AlarmType = atMotion) then Exit;
 
      if AlarmType = atUnknown then
      begin
        unknownAlarm.ShowHint := true;
        unknownAlarm.Hint := ARequestInfo.Params.Text;
      end;
      DoShowForm(AlarmType);
 
      if ini.ReadBool('Client', 'AutoPopup', true) then
      begin
        Application.Restore;
        WindowState := wsNormal;
      end;
 
      if ini.ReadBool('Client', 'AlarmStayOnTop', true) then
        FormStyle := fsStayOnTop
      else
        FormStyle := fsNormal;
 
      MotionDetected;
    finally
      SimpleCS := false;
    end;
  end;
end;
 
procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
  // TODO: when clicked, the icon-selection won't close
  Application.Restore;
  WindowState := wsNormal;
  FormStyle := fsNormal;
  DoShowForm(atMotion);
end;
 
procedure TForm1.UpdateIPTimerTimer(Sender: TObject);
var
  lParamList: TStringList;
  idhttp: TIdHttp;
begin
  try
    try
      lParamList := TStringList.Create;
      lParamList.Add('action=client_subscribe'); // 1.3.6.1.4.1.37476.2.4.1.1
      lParamList.Add('port='+ini.ReadString('Client', 'ListenPort', ''));
      lParamList.Add('ttl='+IntToStr((UpdateIPTimer.Interval div 1000) * 2 + 10));
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0');    // Any
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera
      lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell
 
      idhttp := TIdHTTP.Create(nil);
      try
        idhttp.Post(ControlServerUrl, lParamList);
      finally
        FreeAndNil(idhttp);
      end;
    finally
      FreeAndNil(lParamList);
    end;
  except
    // Nothing
  end;
end;
 
function TForm1.ControlServerUrl: string;
begin
  result := 'http://' + ini.ReadString('Server', 'Address', '127.0.0.1') + ':' + ini.ReadString('Server', 'Port', '80') + '/';
end;
 
procedure TForm1.DoPosition;
  function _TaskBarHeight: integer;
  var
    hTB: HWND;
    TBRect: TRect;
  begin
    hTB := FindWindow('Shell_TrayWnd', '');
    if hTB = 0 then
      Result := 0
    else
    begin
      GetWindowRect(hTB, TBRect);
      Result := TBRect.Bottom - TBRect.Top;
    end;
  end;
begin
  // TODO: modify this code so that it works also if the task bar is on top or on the right corner of the screen
  // TODO: user should select in which corner the window show be
  Self.Left := Screen.Width - Self.Width;
  Self.Top := Screen.Height - Self.Height - _TaskBarHeight;
end;
 
procedure TForm1.DoShowForm(AlarmType: TAlarmType);
begin
  Image1.Visible := AlarmType = atMotion;
  Image2.Visible := AlarmType = atMotion;
 
  // BUGBUG! TODO: This does not work. The panels are not visible for some reason! I just get a white window!
  doorbellPanel.Visible := AlarmType = atDoorbell;
  unknownAlarm.Visible := AlarmType = atUnknown;
 
  if ini.ReadBool('Client', 'AutoReposition', true) then
  begin
    DoPosition;
  end;
 
  Show;
end;
 
end.
 

Rev 2	Rev 7
1	unit DoorAlarmClientMain;	1	unit DoorAlarmClientMain;
2		2
3	// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected	3	// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected, with different event sounds etc
-		4	// TODO: ask server to subscribe/unsubscribe to events (doorbell, motion)
4		5
5	interface	6	interface
6		7
7	uses	8	uses
8	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,	9	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
9	Dialogs, HTTPApp, StdCtrls,	10	Dialogs, HTTPApp, StdCtrls,
10	IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,	11	IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,
11	JPEG, MJPEGDecoderUnit, IniFiles, Menus;	12	JPEG, MJPEGDecoderUnit, IniFiles, Menus;
12		13
13	type	14	type
-		15	TAlarmType = (atUnknown, atMotion, atDoorbell);
-		16
14	TForm1 = class(TForm)	17	TForm1 = class(TForm)
15	Image1: TImage;	18	Image1: TImage;
16	TrayIcon1: TTrayIcon;	19	TrayIcon1: TTrayIcon;
17	PopupMenu1: TPopupMenu;	20	PopupMenu1: TPopupMenu;
18	Exit1: TMenuItem;	21	Exit1: TMenuItem;
19	Open1: TMenuItem;	22	Open1: TMenuItem;
20	Image2: TImage;	23	Image2: TImage;
21	CloseTimer: TTimer;	24	CloseTimer: TTimer;
22	UpdateIPTimer: TTimer;	25	UpdateIPTimer: TTimer;
23	Allowmutingsoundinterface1: TMenuItem;	26	Allowmutingsoundinterface1: TMenuItem;
24	N1: TMenuItem;	27	N1: TMenuItem;
25	Startalarm1: TMenuItem;	28	Startalarm1: TMenuItem;
26	N2: TMenuItem;	29	N2: TMenuItem;
27	Stopalarm1: TMenuItem;	30	Stopalarm1: TMenuItem;
28	Gotocontrolpanelwebsite1: TMenuItem;	31	Gotocontrolpanelwebsite1: TMenuItem;
-		32	doorbellPanel: TPanel;
-		33	N3: TMenuItem;
-		34	Ignoredoorbell1: TMenuItem;
-		35	Ignoremotionalert1: TMenuItem;
-		36	unknownAlarm: TPanel;
29	procedure FormDestroy(Sender: TObject);	37	procedure FormDestroy(Sender: TObject);
30	procedure FormCreate(Sender: TObject);	38	procedure FormCreate(Sender: TObject);
31	procedure TrayIcon1Click(Sender: TObject);	39	procedure TrayIcon1Click(Sender: TObject);
32	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	40	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
33	procedure Exit1Click(Sender: TObject);	41	procedure Exit1Click(Sender: TObject);
34	procedure Open1Click(Sender: TObject);	42	procedure Open1Click(Sender: TObject);
35	procedure FormShow(Sender: TObject);	43	procedure FormShow(Sender: TObject);
36	procedure FormHide(Sender: TObject);	44	procedure FormHide(Sender: TObject);
37	procedure CloseTimerTimer(Sender: TObject);	45	procedure CloseTimerTimer(Sender: TObject);
38	procedure UpdateIPTimerTimer(Sender: TObject);	46	procedure UpdateIPTimerTimer(Sender: TObject);
39	procedure Startalarm1Click(Sender: TObject);	47	procedure Startalarm1Click(Sender: TObject);
40	procedure Stopalarm1Click(Sender: TObject);	48	procedure Stopalarm1Click(Sender: TObject);
41	procedure Gotocontrolpanelwebsite1Click(Sender: TObject);	49	procedure Gotocontrolpanelwebsite1Click(Sender: TObject);
42	procedure ImageClick(Sender: TObject);	50	procedure ImageClick(Sender: TObject);
43	private	51	private
44	MJPEGDecoder: TMJPEGDecoder;	52	MJPEGDecoder: TMJPEGDecoder;
45	LastDingDong: TDateTime;	53	LastDingDong: TDateTime;
46	SimpleCS: boolean;	54	SimpleCS: boolean;
47	ini: TMemIniFile;	55	ini: TMemIniFile;
48	last_known_webcam_port: integer;	56	last_known_webcam_port: integer;
49	procedure ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);	57	procedure ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
50	procedure MotionDetected;	58	procedure MotionDetected;
51	procedure HandleFrame(Sender: TObject; Frame: TJPEGImage);	59	procedure HandleFrame(Sender: TObject; Frame: TJPEGImage);
52	procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;	60	procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
53	procedure StartStream;	61	procedure StartStream;
54	procedure StopStream;	62	procedure StopStream;
55	procedure DoShowForm;	63	procedure DoShowForm(AlarmType: TAlarmType);
56	procedure DoPosition;	64	procedure DoPosition;
57	procedure StopMusic;	65	procedure StopMusic;
58	function ControlServerUrl: string;	66	function ControlServerUrl: string;
59	end;	67	end;
60		68
61	var	69	var
62	Form1: TForm1;	70	Form1: TForm1;
63		71
64	implementation	72	implementation
65		73
66	{$R *.dfm}	74	{$R *.dfm}
67		75
68	uses	76	uses
69	mmSystem, idhttp, DateUtils, ActiveX, ComObj, AudioVolCntrl, ShellAPI;	77	mmSystem, idhttp, DateUtils, ActiveX, ComObj, AudioVolCntrl, ShellAPI;
70		78
71	var	79	var
72	Server: TIdHTTPServer;	80	Server: TIdHTTPServer;
73	gShuttingDown: boolean;	81	gShuttingDown: boolean;
74		82
75	procedure CallUrl(const url: string);	83	procedure CallUrl(const url: string);
76	var	84	var
77	idhttp: TIdHTTP;	85	idhttp: TIdHTTP;
78	begin	86	begin
79	if url <> '' then	87	if url <> '' then
80	begin	88	begin
81	idhttp := TIdHTTP.Create(nil);	89	idhttp := TIdHTTP.Create(nil);
82	try	90	try
83	idhttp.Get(url);	91	idhttp.Get(url);
84	finally	92	finally
85	FreeAndNil(idhttp);	93	FreeAndNil(idhttp);
86	end;	94	end;
87	end;	95	end;
88	end;	96	end;
89		97
90	procedure TForm1.Stopalarm1Click(Sender: TObject);	98	procedure TForm1.Stopalarm1Click(Sender: TObject);
91	var	99	var
92	lParamList: TStringList;	100	lParamList: TStringList;
93	idhttp: TIdHttp;	101	idhttp: TIdHttp;
94	begin	102	begin
95	try	103	try
96	try	104	try
97	lParamList := TStringList.Create;	105	lParamList := TStringList.Create;
98	lParamList.Add('action=motion_off'); // 1.3.6.1.4.1.37476.2.4.1.101	106	lParamList.Add('action=motion_off'); // 1.3.6.1.4.1.37476.2.4.1.101
99		107
100	idhttp := TIdHTTP.Create(nil);	108	idhttp := TIdHTTP.Create(nil);
101	try	109	try
102	idhttp.Post(ControlServerUrl, lParamList);	110	idhttp.Post(ControlServerUrl, lParamList);
103	finally	111	finally
104	FreeAndNil(idhttp);	112	FreeAndNil(idhttp);
105	end;	113	end;
106	finally	114	finally
107	FreeAndNil(lParamList);	115	FreeAndNil(lParamList);
108	end;	116	end;
109	except	117	except
110	// Nothing	118	// Nothing
111	end;	119	end;
112	end;	120	end;
113		121
114	procedure TForm1.StopMusic;	122	procedure TForm1.StopMusic;
115	const	123	const
116	TIMEOUT = 1000; // ms	124	TIMEOUT = 1000; // ms
117	var	125	var
118	lpdwResult: DWORD;	126	lpdwResult: DWORD;
119	begin	127	begin
120	// Stops Spotify, WMP, etc.	128	// Stops Spotify, WMP, etc.
121	lpdwResult := 0;	129	lpdwResult := 0;
122	SendMessageTimeout(HWND_BROADCAST, WM_APPCOMMAND, 0, MAKELONG(0, APPCOMMAND_MEDIA_STOP), SMTO_NORMAL, TIMEOUT, lpdwResult);	130	SendMessageTimeout(HWND_BROADCAST, WM_APPCOMMAND, 0, MAKELONG(0, APPCOMMAND_MEDIA_STOP), SMTO_NORMAL, TIMEOUT, lpdwResult);
123		131
124	// Mutes everything (also YouTube)	132	// Mutes everything (also YouTube)
125	if Allowmutingsoundinterface1.Checked then	133	if Allowmutingsoundinterface1.Checked then
126	begin	134	begin
127	OleCheck(CoInitialize(nil));	135	OleCheck(CoInitialize(nil));
128	try	136	try
129	MuteAllAudioDevices(true);	137	MuteAllAudioDevices(true);
130	finally	138	finally
131	CoUninitialize;	139	CoUninitialize;
132	end;	140	end;
133	end;	141	end;
134	end;	142	end;
135		143
136	procedure TForm1.HandleFrame(Sender: TObject; Frame: TJPEGImage);	144	procedure TForm1.HandleFrame(Sender: TObject; Frame: TJPEGImage);
137	begin	145	begin
138	try	146	try
139	Image1.Picture.Bitmap.Assign(Frame);	147	Image1.Picture.Bitmap.Assign(Frame);
140		148
141	Left := Left + (ClientWidth - Image1.Picture.Width);	149	Left := Left + (ClientWidth - Image1.Picture.Width);
142	Top := Top + (ClientHeight - Image1.Picture.Height);	150	Top := Top + (ClientHeight - Image1.Picture.Height);
143		151
144	ClientWidth := Image1.Picture.Width;	152	ClientWidth := Image1.Picture.Width;
145	ClientHeight := Image1.Picture.Height;	153	ClientHeight := Image1.Picture.Height;
146	finally	154	finally
147	Frame.Free;	155	Frame.Free;
148	end;	156	end;
149	end;	157	end;
150		158
151	procedure TForm1.ImageClick(Sender: TObject);	159	procedure TForm1.ImageClick(Sender: TObject);
152	(*	160	(*
153	var	161	var
154	pnt: TPoint;	162	pnt: TPoint;
155	*)	163	*)
156	begin	164	begin
157	(*	165	(*
158	if GetCursorPos(pnt) then	166	if GetCursorPos(pnt) then
159	PopupMenu1.Popup(pnt.X, pnt.Y);	167	PopupMenu1.Popup(pnt.X, pnt.Y);
160	*)	168	*)
161	end;	169	end;
162		170
163	procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);	171	procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
164	begin	172	begin
165	gShuttingDown := true;	173	gShuttingDown := true;
166	Message.Result := 1;	174	Message.Result := 1;
167	end;	175	end;
168		176
169	procedure TForm1.Startalarm1Click(Sender: TObject);	177	procedure TForm1.Startalarm1Click(Sender: TObject);
170	var	178	var
171	lParamList: TStringList;	179	lParamList: TStringList;
172	idhttp: TIdHttp;	180	idhttp: TIdHttp;
173	begin	181	begin
174	try	182	try
175	try	183	try
176	lParamList := TStringList.Create;	184	lParamList := TStringList.Create;
177	lParamList.Add('action=motion_on'); // 1.3.6.1.4.1.37476.2.4.1.100	185	lParamList.Add('action=motion_on'); // 1.3.6.1.4.1.37476.2.4.1.100
178		186
179	idhttp := TIdHTTP.Create(nil);	187	idhttp := TIdHTTP.Create(nil);
180	try	188	try
181	idhttp.Post(ControlServerUrl, lParamList);	189	idhttp.Post(ControlServerUrl, lParamList);
182	finally	190	finally
183	FreeAndNil(idhttp);	191	FreeAndNil(idhttp);
184	end;	192	end;
185	finally	193	finally
186	FreeAndNil(lParamList);	194	FreeAndNil(lParamList);
187	end;	195	end;
188	except	196	except
189	// Nothing	197	// Nothing
190	end;	198	end;
191	end;	199	end;
192		200
193	procedure TForm1.StartStream;	201	procedure TForm1.StartStream;
194	begin	202	begin
195	if last_known_webcam_port = 0 then exit;	203	if last_known_webcam_port = 0 then exit;
196		204
197	MJPEGDecoder.OnFrame := HandleFrame;	205	MJPEGDecoder.OnFrame := HandleFrame;
198	MJPEGDecoder.OnError := nil;	206	MJPEGDecoder.OnError := nil;
199	MJPEGDecoder.OnMessage := nil;	207	MJPEGDecoder.OnMessage := nil;
200	MJPEGDecoder.Connect(ini.ReadString('Server', 'Address', '127.0.0.1'),	208	MJPEGDecoder.Connect(ini.ReadString('Server', 'Address', '127.0.0.1'),
201	last_known_webcam_port,	209	last_known_webcam_port,
202	'/');	210	'/');
203	end;	211	end;
204		212
205	procedure TForm1.StopStream;	213	procedure TForm1.StopStream;
206	begin	214	begin
207	MJPEGDecoder.Disconnect;	215	MJPEGDecoder.Disconnect;
208	end;	216	end;
209		217
210	procedure TForm1.CloseTimerTimer(Sender: TObject);	218	procedure TForm1.CloseTimerTimer(Sender: TObject);
211	begin	219	begin
212	CloseTimer.Enabled := false;	220	CloseTimer.Enabled := false;
213	Close;	221	Close;
214	end;	222	end;
215		223
216	procedure TForm1.MotionDetected;	224	procedure TForm1.MotionDetected;
217	var	225	var
218	AlarmSound: string;	226	AlarmSound: string;
219	DingDongMinInterval: integer;	227	DingDongMinInterval: integer;
220	begin	228	begin
221	DingDongMinInterval := ini.ReadInteger('Sound', 'AlarmMinInterval', 10);	229	DingDongMinInterval := ini.ReadInteger('Sound', 'AlarmMinInterval', 10);
222	if SecondsBetween(Now, LastDingDong) > DingDongMinInterval then	230	if SecondsBetween(Now, LastDingDong) > DingDongMinInterval then
223	begin	231	begin
224	LastDingDong := Now;	232	LastDingDong := Now;
225		233
226	if ini.ReadBool('Sound', 'StopMusic', true) then	234	if ini.ReadBool('Sound', 'StopMusic', true) then
227	begin	235	begin
228	StopMusic;	236	StopMusic;
229	end;	237	end;
230		238
231	AlarmSound := ini.ReadString('Sound', 'AlarmSoundFile', '');	239	AlarmSound := ini.ReadString('Sound', 'AlarmSoundFile', '');
232	if AlarmSound <> '' then	240	if AlarmSound <> '' then
233	begin	241	begin
234	PlaySound(PChar(AlarmSound), 0, SND_ALIAS or SND_ASYNC);	242	PlaySound(PChar(AlarmSound), 0, SND_ALIAS or SND_ASYNC);
235	end;	243	end;
236	end;	244	end;
237	end;	245	end;
238		246
239	procedure TForm1.Exit1Click(Sender: TObject);	247	procedure TForm1.Exit1Click(Sender: TObject);
240	begin	248	begin
241	gShuttingDown := true;	249	gShuttingDown := true;
242	Close;	250	Close;
243	end;	251	end;
244		252
245	procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);	253	procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
246	begin	254	begin
247	CloseTimer.Enabled := false;	255	CloseTimer.Enabled := false;
248	CanClose := gShuttingDown;	256	CanClose := gShuttingDown;
249	if not CanClose then Hide;	257	if not CanClose then Hide;
250	end;	258	end;
251		259
252	procedure TForm1.FormCreate(Sender: TObject);	260	procedure TForm1.FormCreate(Sender: TObject);
253	begin	261	begin
254	ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));	262	ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
255		263
256	DoubleBuffered := true;	264	DoubleBuffered := true;
257		265
258	Server := TIdHTTPServer.Create();	266	Server := TIdHTTPServer.Create();
259	Server.DefaultPort := ini.ReadInteger('Client', 'ListenPort', 80);	267	Server.DefaultPort := ini.ReadInteger('Client', 'ListenPort', 80);
260	Server.OnCommandGet := ServerCommandGet;	268	Server.OnCommandGet := ServerCommandGet;
261	Server.Active := true;	269	Server.Active := true;
262		270
263	Gotocontrolpanelwebsite1.Visible := true;	271	Gotocontrolpanelwebsite1.Visible := true;
264	Startalarm1.Visible := true;	272	Startalarm1.Visible := true;
265	Stopalarm1.Visible := true;	273	Stopalarm1.Visible := true;
266	N2.Visible := Gotocontrolpanelwebsite1.Visible or Startalarm1.Visible or Stopalarm1.Visible;	274	N2.Visible := Gotocontrolpanelwebsite1.Visible or Startalarm1.Visible or Stopalarm1.Visible;
267		275
268	MJPEGDecoder := TMJPEGDecoder.Create(Self);	276	MJPEGDecoder := TMJPEGDecoder.Create(Self);
269		277
270	DoPosition;	278	DoPosition;
271		279
-		280	// Question: Should these settings also be saved for the next program session?
272	Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false);	281	Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false);
-		282	Ignoredoorbell1.Checked := ini.ReadBool('Client', 'IgnoreDoorbell', false);
-		283	Ignoremotionalert1.Checked := ini.ReadBool('Client', 'IgnoreMotion', false);
273		284
274	UpdateIPTimerTimer(UpdateIPTimer);	285	UpdateIPTimerTimer(UpdateIPTimer);
275	UpdateIPTimer.Interval := ini.ReadInteger('Client', 'SubscribeInterval', 3060) 1000;	286	UpdateIPTimer.Interval := ini.ReadInteger('Client', 'SubscribeInterval', 3060) 1000;
276	UpdateIPTimer.Enabled := true;	287	UpdateIPTimer.Enabled := true;
277	end;	288	end;
278		289
279	procedure TForm1.FormDestroy(Sender: TObject);	290	procedure TForm1.FormDestroy(Sender: TObject);
280	begin	291	begin
281	if Assigned(Server) then Server.Active := false;	292	if Assigned(Server) then Server.Active := false;
282	FreeAndNil(Server);	293	FreeAndNil(Server);
283		294
284	FreeAndNil(ini);	295	FreeAndNil(ini);
285		296
286	FreeAndNil(MJPEGDecoder);	297	FreeAndNil(MJPEGDecoder);
287	end;	298	end;
288		299
289	procedure TForm1.FormHide(Sender: TObject);	300	procedure TForm1.FormHide(Sender: TObject);
290	begin	301	begin
-		302	if Image2.Visible then
291	StopStream;	303	StopStream;
292	end;	304	end;
293		305
294	procedure TForm1.FormShow(Sender: TObject);	306	procedure TForm1.FormShow(Sender: TObject);
295	begin	307	begin
-		308	if Image2.Visible then
296	StartStream;	309	StartStream;
297	end;	310	end;
298		311
299	procedure TForm1.Gotocontrolpanelwebsite1Click(Sender: TObject);	312	procedure TForm1.Gotocontrolpanelwebsite1Click(Sender: TObject);
300	begin	313	begin
301	ShellExecute(Handle, 'open', PChar(ControlServerUrl), '', '', SW_NORMAL);	314	ShellExecute(Handle, 'open', PChar(ControlServerUrl), '', '', SW_NORMAL);
302	end;	315	end;
303		316
304	procedure TForm1.Open1Click(Sender: TObject);	317	procedure TForm1.Open1Click(Sender: TObject);
305	begin	318	begin
306	TrayIcon1Click(TrayIcon1);	319	TrayIcon1Click(TrayIcon1);
307	end;	320	end;
308		321
309	procedure TForm1.ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);	322	procedure TForm1.ServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
310	var	323	var
311	AutoCloseTimerInterval: integer;	324	AutoCloseTimerInterval: integer;
-		325	AlarmType: TAlarmType;
312	begin	326	begin
313	aResponseInfo.ResponseNo := 200;	327	aResponseInfo.ResponseNo := 200;
314	aResponseInfo.ContentType := 'text/html';	328	aResponseInfo.ContentType := 'text/html';
315	aResponseInfo.ContentText := '';	329	aResponseInfo.ContentText := '';
316		330
317	if (ARequestInfo.CommandType = hcPOST) and	331	if (ARequestInfo.CommandType = hcPOST) and
318	(ARequestInfo.Params.Values['action'] = 'client_alert') then // 1.3.6.1.4.1.37476.2.4.1.3	332	(ARequestInfo.Params.Values['action'] = 'client_alert') then // 1.3.6.1.4.1.37476.2.4.1.3
319	begin	333	begin
320	if ARequestInfo.Params.Values['motion_port'] <> '' then	334	if ARequestInfo.Params.Values['motion_port'] <> '' then
321	begin	335	begin
322	TryStrToInt(ARequestInfo.Params.Values['motion_port'], last_known_webcam_port);	336	TryStrToInt(ARequestInfo.Params.Values['motion_port'], last_known_webcam_port);
323	end;	337	end;
324		338
325	if ARequestInfo.Params.Values['simulation'] = '1' then	339	if ARequestInfo.Params.Values['simulation'] = '1' then
326	begin	340	begin
327	exit;	341	exit;
328	end;	342	end;
329		343
330	if SimpleCS then exit;	344	if SimpleCS then exit;
331	SimpleCS := true;	345	SimpleCS := true;
332	try	346	try
333	if CloseTimer.Enabled then	347	if CloseTimer.Enabled then
334	begin	348	begin
335	CloseTimer.Enabled := false;	349	CloseTimer.Enabled := false;
336	CloseTimer.Enabled := true; // "Restart" timer	350	CloseTimer.Enabled := true; // "Restart" timer
337	end;	351	end;
338		352
339	AutoCloseTimerInterval := ini.ReadInteger('Client', 'AutoCloseTimer', 5000);	353	AutoCloseTimerInterval := ini.ReadInteger('Client', 'AutoCloseTimer', 5000);
340	if (not Visible) and (AutoCloseTimerInterval <> -1) then	354	if (not Visible) and (AutoCloseTimerInterval <> -1) then
341	begin	355	begin
342	CloseTimer.Interval := AutoCloseTimerInterval;	356	CloseTimer.Interval := AutoCloseTimerInterval;
343	CloseTimer.Enabled := true;	357	CloseTimer.Enabled := true;
344	end;	358	end;
345		359
-		360	if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.1002' {camera, motion}) >= 0 then
-		361	AlarmType := atMotion
-		362	else if ARequestInfo.Params.IndexOf('targets=1.3.6.1.4.1.37476.2.4.2.2001' {sound, doorbell}) >= 0 then
-		363	AlarmType := atDoorbell
-		364	else
-		365	begin
-		366	// TODO: Make plugin DLLs ?
-		367	AlarmType := atUnknown;
-		368	end;
-		369
-		370	// Attention: Ignoring these events at the client does not prevent the server
-		371	// doing other actions (e.g. ask Spotify to stop the music on connected devices)
-		372	if Ignoredoorbell1.Checked and (AlarmType = atDoorbell) then Exit;
-		373	if Ignoremotionalert1.Checked and (AlarmType = atMotion) then Exit;
-		374
-		375	if AlarmType = atUnknown then
-		376	begin
-		377	unknownAlarm.ShowHint := true;
-		378	unknownAlarm.Hint := ARequestInfo.Params.Text;
-		379	end;
346	DoShowForm;	380	DoShowForm(AlarmType);
347		381
348	if ini.ReadBool('Client', 'AutoPopup', true) then	382	if ini.ReadBool('Client', 'AutoPopup', true) then
349	begin	383	begin
350	Application.Restore;	384	Application.Restore;
351	WindowState := wsNormal;	385	WindowState := wsNormal;
352	end;	386	end;
353		387
354	if ini.ReadBool('Client', 'AlarmStayOnTop', true) then	388	if ini.ReadBool('Client', 'AlarmStayOnTop', true) then
355	FormStyle := fsStayOnTop	389	FormStyle := fsStayOnTop
356	else	390	else
357	FormStyle := fsNormal;	391	FormStyle := fsNormal;
358		392
359	MotionDetected;	393	MotionDetected;
360	finally	394	finally
361	SimpleCS := false;	395	SimpleCS := false;
362	end;	396	end;
363	end;	397	end;
364	end;	398	end;
365		399
366	procedure TForm1.TrayIcon1Click(Sender: TObject);	400	procedure TForm1.TrayIcon1Click(Sender: TObject);
367	begin	401	begin
368	// TODO: when clicked, the icon-selection won't close	402	// TODO: when clicked, the icon-selection won't close
369	Application.Restore;	403	Application.Restore;
370	WindowState := wsNormal;	404	WindowState := wsNormal;
371	FormStyle := fsNormal;	405	FormStyle := fsNormal;
372	DoShowForm;	406	DoShowForm(atMotion);
373	end;	407	end;
374		408
375	procedure TForm1.UpdateIPTimerTimer(Sender: TObject);	409	procedure TForm1.UpdateIPTimerTimer(Sender: TObject);
376	var	410	var
377	lParamList: TStringList;	411	lParamList: TStringList;
378	idhttp: TIdHttp;	412	idhttp: TIdHttp;
379	begin	413	begin
380	try	414	try
381	try	415	try
382	lParamList := TStringList.Create;	416	lParamList := TStringList.Create;
383	lParamList.Add('action=client_subscribe'); // 1.3.6.1.4.1.37476.2.4.1.1	417	lParamList.Add('action=client_subscribe'); // 1.3.6.1.4.1.37476.2.4.1.1
384	lParamList.Add('port='+ini.ReadString('Client', 'ListenPort', ''));	418	lParamList.Add('port='+ini.ReadString('Client', 'ListenPort', ''));
385	lParamList.Add('ttl='+IntToStr((UpdateIPTimer.Interval div 1000) * 2 + 10));	419	lParamList.Add('ttl='+IntToStr((UpdateIPTimer.Interval div 1000) * 2 + 10));
386	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0'); // Any	420	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.0'); // Any
387	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera	421	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.1002'); // Motion, camera
-		422	lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell
388		423
389	idhttp := TIdHTTP.Create(nil);	424	idhttp := TIdHTTP.Create(nil);
390	try	425	try
391	idhttp.Post(ControlServerUrl, lParamList);	426	idhttp.Post(ControlServerUrl, lParamList);
392	finally	427	finally
393	FreeAndNil(idhttp);	428	FreeAndNil(idhttp);
394	end;	429	end;
395	finally	430	finally
396	FreeAndNil(lParamList);	431	FreeAndNil(lParamList);
397	end;	432	end;
398	except	433	except
399	// Nothing	434	// Nothing
400	end;	435	end;
401	end;	436	end;
402		437
403	function TForm1.ControlServerUrl: string;	438	function TForm1.ControlServerUrl: string;
404	begin	439	begin
405	result := 'http://' + ini.ReadString('Server', 'Address', '127.0.0.1') + ':' + ini.ReadString('Server', 'Port', '80') + '/';	440	result := 'http://' + ini.ReadString('Server', 'Address', '127.0.0.1') + ':' + ini.ReadString('Server', 'Port', '80') + '/';
406	end;	441	end;
407		442
408	procedure TForm1.DoPosition;	443	procedure TForm1.DoPosition;
409	function _TaskBarHeight: integer;	444	function _TaskBarHeight: integer;
410	var	445	var
411	hTB: HWND;	446	hTB: HWND;
412	TBRect: TRect;	447	TBRect: TRect;
413	begin	448	begin
414	hTB := FindWindow('Shell_TrayWnd', '');	449	hTB := FindWindow('Shell_TrayWnd', '');
415	if hTB = 0 then	450	if hTB = 0 then
416	Result := 0	451	Result := 0
417	else	452	else
418	begin	453	begin
419	GetWindowRect(hTB, TBRect);	454	GetWindowRect(hTB, TBRect);
420	Result := TBRect.Bottom - TBRect.Top;	455	Result := TBRect.Bottom - TBRect.Top;
421	end;	456	end;
422	end;	457	end;
423	begin	458	begin
424	// TODO: modify this code so that it works also if the task bar is on top or on the right corner of the screen	459	// TODO: modify this code so that it works also if the task bar is on top or on the right corner of the screen
425	// TODO: user should select in which corner the window show be	460	// TODO: user should select in which corner the window show be
426	Self.Left := Screen.Width - Self.Width;	461	Self.Left := Screen.Width - Self.Width;
427	Self.Top := Screen.Height - Self.Height - _TaskBarHeight;	462	Self.Top := Screen.Height - Self.Height - _TaskBarHeight;
428	end;	463	end;
429		464
430	procedure TForm1.DoShowForm;	465	procedure TForm1.DoShowForm(AlarmType: TAlarmType);
431	begin	466	begin
-		467	Image1.Visible := AlarmType = atMotion;
-		468	Image2.Visible := AlarmType = atMotion;
-		469
-		470	// BUGBUG! TODO: This does not work. The panels are not visible for some reason! I just get a white window!
-		471	doorbellPanel.Visible := AlarmType = atDoorbell;
-		472	unknownAlarm.Visible := AlarmType = atUnknown;
-		473
432	if ini.ReadBool('Client', 'AutoReposition', true) then	474	if ini.ReadBool('Client', 'AutoReposition', true) then
433	begin	475	begin
434	DoPosition;	476	DoPosition;
435	end;	477	end;
436		478
437	Show;	479	Show;
438	end;	480	end;
439		481
440	end.	482	end.
441		483

Subversion Repositories alarming

alarming/trunk/Delphi Client/DoorAlarmClientMain.pas – Rev 2 → 7