Subversion Repositories alarming

Rev

Rev 2 | Rev 9 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

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