Rev 2 | Rev 9 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 1 | unit DoorAlarmClientMain; |
2 | |||
7 | daniel-mar | 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) |
||
2 | daniel-mar | 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 |
||
7 | daniel-mar | 15 | TAlarmType = (atUnknown, atMotion, atDoorbell); |
16 | |||
2 | daniel-mar | 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; |
||
7 | daniel-mar | 32 | doorbellPanel: TPanel; |
33 | N3: TMenuItem; |
||
34 | Ignoredoorbell1: TMenuItem; |
||
35 | Ignoremotionalert1: TMenuItem; |
||
36 | unknownAlarm: TPanel; |
||
2 | daniel-mar | 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; |
||
7 | daniel-mar | 63 | procedure DoShowForm(AlarmType: TAlarmType); |
2 | daniel-mar | 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 | |||
7 | daniel-mar | 280 | // Question: Should these settings also be saved for the next program session? |
2 | daniel-mar | 281 | Allowmutingsoundinterface1.Checked := ini.ReadBool('Client', 'AllowMute', false); |
7 | daniel-mar | 282 | Ignoredoorbell1.Checked := ini.ReadBool('Client', 'IgnoreDoorbell', false); |
283 | Ignoremotionalert1.Checked := ini.ReadBool('Client', 'IgnoreMotion', false); |
||
2 | daniel-mar | 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 |
||
7 | daniel-mar | 302 | if Image2.Visible then |
303 | StopStream; |
||
2 | daniel-mar | 304 | end; |
305 | |||
306 | procedure TForm1.FormShow(Sender: TObject); |
||
307 | begin |
||
7 | daniel-mar | 308 | if Image2.Visible then |
309 | StartStream; |
||
2 | daniel-mar | 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; |
||
7 | daniel-mar | 325 | AlarmType: TAlarmType; |
2 | daniel-mar | 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 | |||
7 | daniel-mar | 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; |
||
2 | daniel-mar | 369 | |
7 | daniel-mar | 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 | |||
2 | daniel-mar | 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; |
||
7 | daniel-mar | 406 | DoShowForm(atMotion); |
2 | daniel-mar | 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 |
||
7 | daniel-mar | 422 | lParamList.Add('targets=1.3.6.1.4.1.37476.2.4.2.2001'); // Sound, doorbell |
2 | daniel-mar | 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 | |||
7 | daniel-mar | 465 | procedure TForm1.DoShowForm(AlarmType: TAlarmType); |
2 | daniel-mar | 466 | begin |
7 | daniel-mar | 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 | |||
2 | daniel-mar | 474 | if ini.ReadBool('Client', 'AutoReposition', true) then |
475 | begin |
||
476 | DoPosition; |
||
477 | end; |
||
478 | |||
479 | Show; |
||
480 | end; |
||
481 | |||
482 | end. |