Rev 7 | Go to most recent revision | Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 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. |