Subversion Repositories alarming

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;

    Simulatealarm1: 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);

    procedure Simulatealarm1Click(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

      UpdateIPTimerTimer(UpdateIPTimer); // make sure we are registered

      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

      UpdateIPTimerTimer(UpdateIPTimer); // make sure we are registered

      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.Simulatealarm1Click(Sender: TObject);

var

  lParamList: TStringList;

  idhttp: TIdHttp;

begin

  //try

    try

      lParamList := TStringList.Create;

      lParamList.Add('action=server_alert'); // 1.3.6.1.4.1.37476.2.4.1.2

      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;

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.