| 1 | unit WebCamPage;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Classes, SysUtils, FileUtil, WebPage, HTTPServer, HtmlClasses, SqlDatabase,
|
|---|
| 7 | ModuleUser, DateUtils;
|
|---|
| 8 |
|
|---|
| 9 | type
|
|---|
| 10 |
|
|---|
| 11 | { TWebCamPage }
|
|---|
| 12 |
|
|---|
| 13 | TWebCamPage = class(TWebPage)
|
|---|
| 14 | procedure DataModuleProduce(HandlerData: THTTPHandlerData);
|
|---|
| 15 | private
|
|---|
| 16 | ImageWidth: Integer;
|
|---|
| 17 | ImageHeight: Integer;
|
|---|
| 18 | function GetAll(HandlerData: THTTPHandlerData): string;
|
|---|
| 19 | function GetSingle(HandlerData: THTTPHandlerData; Id: Integer): string;
|
|---|
| 20 | function GetVideoArchive(Id: string): string;
|
|---|
| 21 | end;
|
|---|
| 22 |
|
|---|
| 23 | var
|
|---|
| 24 | WebCamPage: TWebCamPage;
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 | implementation
|
|---|
| 28 |
|
|---|
| 29 | {$R *.lfm}
|
|---|
| 30 |
|
|---|
| 31 | uses
|
|---|
| 32 | Core, Utils, WebSession;
|
|---|
| 33 |
|
|---|
| 34 |
|
|---|
| 35 | { TWebCamPage }
|
|---|
| 36 |
|
|---|
| 37 | procedure TWebCamPage.DataModuleProduce(HandlerData: THTTPHandlerData);
|
|---|
| 38 | var
|
|---|
| 39 | DbRows: TDbRows;
|
|---|
| 40 | I: Integer;
|
|---|
| 41 | CameraId: Integer;
|
|---|
| 42 | SubPageName: string;
|
|---|
| 43 | Value: Integer;
|
|---|
| 44 | NotFound: Boolean;
|
|---|
| 45 | WidthValue: string;
|
|---|
| 46 | ModuleUser: TModuleUser;
|
|---|
| 47 | begin
|
|---|
| 48 | with TWebSession(HandlerData) do begin
|
|---|
| 49 | ModuleUser := TModuleUser(ModuleManager.FindModuleByName('User'));
|
|---|
| 50 | ModuleUser.LoadUserInfo;
|
|---|
| 51 | with HtmlDocument.Body, SubItems.AddString do begin
|
|---|
| 52 | Text := '';
|
|---|
| 53 | CameraId := -1;
|
|---|
| 54 | NotFound := False;
|
|---|
| 55 | if Request.Path.Count = 2 then begin
|
|---|
| 56 | SubPageName := Request.Path[1];
|
|---|
| 57 | if TryStrToInt(SubPageName, Value) then
|
|---|
| 58 | CameraId := Value else
|
|---|
| 59 | NotFound := True;
|
|---|
| 60 | end else
|
|---|
| 61 | if Request.Path.Count > 2 then NotFound := True;
|
|---|
| 62 | if NotFound then begin
|
|---|
| 63 | PageNotFound;
|
|---|
| 64 | Exit;
|
|---|
| 65 | end;
|
|---|
| 66 |
|
|---|
| 67 | if HandlerData.Request.Query.TryGetValue('W', WidthValue) then
|
|---|
| 68 | ImageWidth := StrToInt(WidthValue)
|
|---|
| 69 | else ImageWidth := 640;
|
|---|
| 70 |
|
|---|
| 71 | Text := Text + '<table style="width: 100%"><tr><td style="width: 20%" valign="top">' +
|
|---|
| 72 | '<strong>Velikost</strong><br/>' +
|
|---|
| 73 | '<a href="?W=160">Malá</a><br/> ' +
|
|---|
| 74 | '<a href="?W=320">Menší</a><br/> ' +
|
|---|
| 75 | '<a href="?W=640">Střední</a><br/> ' +
|
|---|
| 76 | '<a href="?W=1024">Větší</a><br/> ' +
|
|---|
| 77 | '<a href="?W=1280">Velká</a><br/><br/>';
|
|---|
| 78 |
|
|---|
| 79 | Text := Text + '<strong>Místní kamery</strong><br/>';
|
|---|
| 80 | Text := Text + MakeLink('Všechny', NavigationLink('/kamery/?W=' + IntToStr(ImageWidth))) + '<br/>';
|
|---|
| 81 | try
|
|---|
| 82 | DbRows := TDbRows.Create;
|
|---|
| 83 | Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE `Enabled`=1 AND `Public`=1');
|
|---|
| 84 | for I := 0 to DbRows.Count - 1 do begin
|
|---|
| 85 | Text := Text + MakeLink(DbRows[I].Items['Name'], NavigationLink(
|
|---|
| 86 | '/kamery/' + DbRows[I].Items['Id'] + '/?W=' + IntToStr(ImageWidth))) + '<br/>';
|
|---|
| 87 | end;
|
|---|
| 88 | finally
|
|---|
| 89 | DbRows.Free;
|
|---|
| 90 | end;
|
|---|
| 91 |
|
|---|
| 92 | Text := Text + '<br/><strong>Kamery v okolí:</strong><br />' +
|
|---|
| 93 | '<a href="https://www.mestovsetin.cz/webove%2Dkamery/d-480245">Vsetínské kamery</a><br />' +
|
|---|
| 94 | '<a href="https://www.huslenky.cz/webkamery%2Dhuslenky/ds-1119/archiv=0&p1=1020">Kamery v Huslenkách</a><br/>' +
|
|---|
| 95 | '<a href="https://kamery.hovnet.cz/">Kamery v Hovnetu</a><br/>' +
|
|---|
| 96 | '</td><td style="width: 80%" valign="top">';
|
|---|
| 97 |
|
|---|
| 98 | if CameraId = -1 then begin
|
|---|
| 99 | Text := Text + GetAll(HandlerData);
|
|---|
| 100 | end else begin
|
|---|
| 101 | Text := Text + GetSingle(HandlerData, CameraId);
|
|---|
| 102 | end;
|
|---|
| 103 | Text := Text + '</td></tr></table>';
|
|---|
| 104 | end;
|
|---|
| 105 | GeneratePage(Self);
|
|---|
| 106 | end;
|
|---|
| 107 | end;
|
|---|
| 108 |
|
|---|
| 109 | function TWebCamPage.GetAll(HandlerData: THTTPHandlerData): string;
|
|---|
| 110 | var
|
|---|
| 111 | DbRows: TDbRows;
|
|---|
| 112 | I: Integer;
|
|---|
| 113 | ImageWidthThumb: Integer;
|
|---|
| 114 | ImageHeightThumb: Integer;
|
|---|
| 115 | WebCamImage: string;
|
|---|
| 116 | begin
|
|---|
| 117 | Result := '';
|
|---|
| 118 | with TWebSession(HandlerData) do
|
|---|
| 119 | try
|
|---|
| 120 | DbRows := TDbRows.Create;
|
|---|
| 121 | Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE `Enabled`=1 AND `Public`=1');
|
|---|
| 122 | ImageWidthThumb := 160;
|
|---|
| 123 | for I := 0 to DbRows.Count - 1 do begin
|
|---|
| 124 | ImageHeightThumb := Round(ImageWidthThumb * StrToInt(DbRows[I].Items['Height']) / StrToInt(DbRows[I].Items['Width']));
|
|---|
| 125 | WebCamImage := 'images/webcam/' + DbRows[I].Items['ImageName'];
|
|---|
| 126 | Result := Result + '<span align="center" valign="middle" style="vertical-align: middle;">' + //DbRows[I].Values['Name'] + '<br/>' +
|
|---|
| 127 | '<a href="' + NavigationLink('/kamery/' + DbRows[I].Items['Id'] + '/?W=' + IntToStr(ImageWidth)) + '">' +
|
|---|
| 128 | '<img name="theImage" src="' + NavigationLink('/' + WebCamImage) + '" width="' +
|
|---|
| 129 | IntToStr(ImageWidthThumb) + '" height="' + IntToStr(ImageHeightThumb) + '" alt="' +
|
|---|
| 130 | DbRows[I].Items['Name'] + '"/></a></span> ';
|
|---|
| 131 | end;
|
|---|
| 132 | finally
|
|---|
| 133 | DbRows.Free;
|
|---|
| 134 | end;
|
|---|
| 135 | end;
|
|---|
| 136 |
|
|---|
| 137 | function TWebCamPage.GetSingle(HandlerData: THTTPHandlerData; Id: Integer): string;
|
|---|
| 138 | var
|
|---|
| 139 | DbRows: TDbRows;
|
|---|
| 140 | I: Integer;
|
|---|
| 141 | WebCamImage: string;
|
|---|
| 142 | RefreshInterval: Integer;
|
|---|
| 143 | LastFileDate: string;
|
|---|
| 144 | Token: string;
|
|---|
| 145 | begin
|
|---|
| 146 | Result := '';
|
|---|
| 147 | with TWebSession(HandlerData) do
|
|---|
| 148 | try
|
|---|
| 149 | if HandlerData.Request.Query.TryGetValue('Token', Token) then
|
|---|
| 150 | else Token := '';
|
|---|
| 151 |
|
|---|
| 152 | DbRows := TDbRows.Create;
|
|---|
| 153 | Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE (`Id`=' +
|
|---|
| 154 | IntToStr(Id) + ') AND (`Enabled`=1) AND ' +
|
|---|
| 155 | '((`Public` = 1) OR ((`Public` = 0) AND (`Token`="' +
|
|---|
| 156 | Database.EscapeString(Token) + '")))');
|
|---|
| 157 | if DbRows.Count > 0 then begin
|
|---|
| 158 | WebCamImage := 'images/webcam/' + DbRows[0].Items['ImageName'];
|
|---|
| 159 | RefreshInterval := StrToInt(DbRows[0].Items['ImagePeriod']);
|
|---|
| 160 | ImageHeight := Round(ImageWidth * StrToInt(DbRows[0].Items['Height']) / StrToInt(DbRows[0].Items['Width']));
|
|---|
| 161 |
|
|---|
| 162 | if FileExists(WebCamImage) then begin
|
|---|
| 163 | DateTimeToString(LastFileDate, 'hh:mm:ss d.m.yyyy', FileDateToDateTime(FileAge(WebCamImage)));
|
|---|
| 164 | Result := Result + '<script language="JavaScript">' + #13#10 +
|
|---|
| 165 | ' var ImageURL= "' + NavigationLink('/' + WebCamImage) + '";' + #13#10 +
|
|---|
| 166 | '' + #13#10 +
|
|---|
| 167 | '// Force an immediate image load' + #13#10 +
|
|---|
| 168 | 'var theTimer = setTimeout("reloadImage()", 1);' + #13#10 +
|
|---|
| 169 | '' + #13#10 +
|
|---|
| 170 | 'function reloadImage()' + #13#10 +
|
|---|
| 171 | '{' + #13#10 +
|
|---|
| 172 | ' theDate = new Date();' + #13#10 +
|
|---|
| 173 | ' var url = ImageURL;' + #13#10 +
|
|---|
| 174 | ' url += "?dummy=";' + #13#10 +
|
|---|
| 175 | ' url += theDate.getTime().toString(10);' + #13#10 +
|
|---|
| 176 | ' // The above dummy cgi-parameter enforce a bypass of the browser image cache.' + #13#10 +
|
|---|
| 177 | ' // Here we actually load the image' + #13#10 +
|
|---|
| 178 | ' document.theImage.src = document.theImageTemp.src;' + #13#10 +
|
|---|
| 179 | ' document.theImageTemp.src = url;' + #13#10 +
|
|---|
| 180 | '' + #13#10 +
|
|---|
| 181 | ' // Reload the image every defined period' + #13#10 +
|
|---|
| 182 | ' theTimer = setTimeout("reloadImage()", ' + IntToStr(RefreshInterval * 1000) + ');' + #13#10 +
|
|---|
| 183 | '}' + #13#10 +
|
|---|
| 184 | '</script>' + #13#10 +
|
|---|
| 185 |
|
|---|
| 186 | '<br /><div align="center">' + DbRows[0].Items['Name'] + '<br/>' +
|
|---|
| 187 | '<img name="theImageTemp" src="' + NavigationLink('/' + WebCamImage) + '" width="0" height="0" alt="Temp image"/>' +
|
|---|
| 188 | '<img name="theImage" src="' + NavigationLink('/' + WebCamImage) + '" width="' + IntToStr(ImageWidth) +
|
|---|
| 189 | '" height="' + IntToStr(ImageHeight) + '" alt="' +
|
|---|
| 190 | DbRows[0].Items['Name'] + '"/></div>';
|
|---|
| 191 | end else Result := Result + '<br />Obrázek nenalezen.<br /><br />';
|
|---|
| 192 | Result := Result + '<br/><div align="center">';
|
|---|
| 193 | if LastFileDate <> '' then Result := Result + 'Aktualizace: <span id="lasttime">' +
|
|---|
| 194 | LastFileDate + '</span>, ';
|
|---|
| 195 | Result := Result + 'Perioda: ' + IntToStr(RefreshInterval) + ' sekund, Typ: ' +
|
|---|
| 196 | DbRows[0].Items['DeviceType'] + '<br />' +
|
|---|
| 197 | '<br/>' + DbRows[0].Items['Description'];
|
|---|
| 198 | Result := Result + GetVideoArchive(DbRows[0].Items['Id']) + '</div>';
|
|---|
| 199 | end else Result := Result + '<br />Id kamery nenalezeno.<br/><br>';
|
|---|
| 200 | finally
|
|---|
| 201 | DbRows.Free;
|
|---|
| 202 | end;
|
|---|
| 203 | end;
|
|---|
| 204 |
|
|---|
| 205 | function TWebCamPage.GetVideoArchive(Id: string): string;
|
|---|
| 206 | var
|
|---|
| 207 | I: Integer;
|
|---|
| 208 | Items: TStringList;
|
|---|
| 209 | DateStr: string;
|
|---|
| 210 | VideoPathFormat: string;
|
|---|
| 211 | Date: TDateTime;
|
|---|
| 212 | Video: string;
|
|---|
| 213 | const
|
|---|
| 214 | OneDay = 24 * OneHour;
|
|---|
| 215 | begin
|
|---|
| 216 | Result := '';
|
|---|
| 217 | VideoPathFormat := 'images/webcam_archive/%s/%s/video.mp4';
|
|---|
| 218 | Items := TStringList.Create;
|
|---|
| 219 | try
|
|---|
| 220 | Date := Now - OneDay;
|
|---|
| 221 | repeat
|
|---|
| 222 | DateStr := FormatDateTime('yyyy-mm-dd', Date);
|
|---|
| 223 | Video := Format(VideoPathFormat, [DateStr, Id]);
|
|---|
| 224 | if FileExists(Video) then begin
|
|---|
| 225 | Items.Add(DateStr + Items.NameValueSeparator + Video);
|
|---|
| 226 | Date := Date - OneDay;
|
|---|
| 227 | Continue;
|
|---|
| 228 | end else Break;
|
|---|
| 229 | until False;
|
|---|
| 230 |
|
|---|
| 231 | if Items.Count > 0 then begin
|
|---|
| 232 | Result := '<br/>Video archív: <select name="dates" id="dates">';
|
|---|
| 233 | for I := 0 to Items.Count - 1 do begin
|
|---|
| 234 | Result := Result + '<option value="' + NavigationLink('/' + Items.ValueFromIndex[I]) + '">' + Items.Names[I] + '</option>';
|
|---|
| 235 | end;
|
|---|
| 236 | Result := Result + '</select>';
|
|---|
| 237 | Result := Result + ' <button onclick="var element = document.getElementById(''dates''); window.open(element.value, ''_blank'')">Zobrazit</button>';
|
|---|
| 238 | end;
|
|---|
| 239 | finally
|
|---|
| 240 | Items.Free;
|
|---|
| 241 | end;
|
|---|
| 242 | end;
|
|---|
| 243 |
|
|---|
| 244 | end.
|
|---|
| 245 |
|
|---|
