Subversion Repositories alarming

Rev

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