Subversion Repositories alarming

Compare Revisions

Regard whitespace Rev 1 → Rev 2

/trunk/Delphi Client/DoorAlarmClientMain.pas
0,0 → 1,440
unit DoorAlarmClientMain;
 
// TODO: make configurable, which actions should be executed (e.g. run programs) when a motion was detected
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, HTTPApp, StdCtrls,
IdHTTPServer, idContext, idCustomHTTPServer, OleCtrls, SHDocVw, ExtCtrls,
JPEG, MJPEGDecoderUnit, IniFiles, Menus;
 
type
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;
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;
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;
 
Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', 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
StopStream;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
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;
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;
 
DoShowForm;
 
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;
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
 
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;
begin
if ini.ReadBool('Client', 'AutoReposition', true) then
begin
DoPosition;
end;
 
Show;
end;
 
end.