Ignore:
Timestamp:
Sep 9, 2022, 1:16:58 AM (2 years ago)
Author:
chronos
Message:
  • Added: Robots page.
  • Modified: Canonical URL for webcams.
  • Modified: Removed compiler mode delphi as it is already set in project.
  • Modified: Updated Common package.
  • Modified: Use Generics.Collections instead of fgl.
Location:
trunk/Modules/ZdechovNET
Files:
2 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Modules/ZdechovNET/UAboutPage.pas

    r135 r137  
    103103end;
    104104
    105 initialization
    106 
    107105end.
    108106

  • trunk/Modules/ZdechovNET/UIPTVPage.pas

    r135 r137  
    44
    55uses
    6   Classes, SysUtils, FileUtil, UWebPage, UHTTPServer, UModuleUser, fgl;
     6  Classes, SysUtils, FileUtil, UWebPage, UHTTPServer, UModuleUser,
     7  Generics.Collections;
    78
    89type
    … …  
    1819  { TChannels }
    1920
    20   TChannels = class(TFPGObjectList<TChannel>)
     21  TChannels = class(TObjectList<TChannel>)
    2122    function AddNew(Name: string; Groups: TChannelGroups): TChannel;
    2223    function GetNamesByGroup(Group: TChannelGroup): string;

  • trunk/Modules/ZdechovNET/UModuleZdechovNET.pas

    r135 r137  
    44
    55uses
    6   Classes, SysUtils, UModularSystem, UWebPage,
     6  Classes, SysUtils, UModularSystem, UWebPage, URobotsPage,
    77  UWebSession, DateUtils, UModuleBase, UModuleUser, UIPTVPage,
    88  UInternetPage, UHostingPage, UHistoryPage, UDocumentsPage, UVoIPPage,
    … …  
    3030    AboutPage: TAboutPage;
    3131    IPTVPage: TIPTVPage;
     32    RobotsPage: TRobotsPage;
    3233    procedure Footer(Session: TWebSession);
    3334    procedure GeneratePage(ASession: TWebSession; Page: TWebPage);
    … …  
    3637    ModuleBase: TModuleBase;
    3738    ModuleUser: TModuleUser;
     39    Raw: Boolean;
    3840    constructor Create(Owner: TComponent); override;
    3941    destructor Destroy; override;
    … …  
    7476  BeforeStart;
    7577  ModuleBase := TModuleBase(Manager.FindModuleByName('Base'));
    76   ModuleBase.GeneratePage := GeneratePage;
     78  ModuleBase.OnGeneratePage := GeneratePage;
    7779  ModuleUser := TModuleUser(Manager.FindModuleByName('User'));
    7880  with ModuleBase, Pages do begin
    79     //GeneratePage := GeneratePage;
     81    //OnGeneratePage := OnGeneratePage;
    8082    InternetPage := TInternetPage.Create(nil);
    8183    InternetPage.ModuleUser := ModuleUser;
    … …  
    120122    IPTVPage.ModuleUser := ModuleUser;
    121123    RegisterPage(IPTVPage, 'televize');
     124    RobotsPage := TRobotsPage.Create(nil);
     125    RobotsPage.ModuleUser := ModuleUser;
     126    RegisterPage(RobotsPage, 'robots.txt');
    122127  end;
    123128  AfterStart;
    … …  
    156161    UnregisterPage(ProjectsPage);
    157162    FreeAndNil(ProjectsPage);
     163    UnregisterPage(RobotsPage);
     164    FreeAndNil(RobotsPage);
    158165  end;
    159166  ModuleBase := nil;
    … …  
    242249begin
    243250  inherited;
    244   ModuleBase.GeneratePage := nil;
     251  ModuleBase.OnGeneratePage := nil;
    245252  try
    246253    DbRows := TDbRows.Create;
    … …  
    348355begin
    349356  with ASession do begin
    350     HtmlDocument.ContentLanguage := 'cs';
    351     GlobalTitle := 'ZděchovNET';
    352     HtmlDocument.Styles.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Style.css'));
    353     HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Global.js'));
    354     HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/jquery.js'));
     357    if Page.Raw then begin
     358      Response.Content.WriteString(THtmlString(HtmlDocument.Body.SubItems[0]).Text);
     359    end else begin
     360      HtmlDocument.ContentLanguage := 'cs';
     361      GlobalTitle := 'ZděchovNET';
     362      HtmlDocument.Styles.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Style.css'));
     363      HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Global.js'));
     364      HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/jquery.js'));
    355365
    356366      TitleTag := THtmlString.Create;
    … …  
    370380      end;
    371381    end;
     382  end;
    372383end;
    373384

  • trunk/Modules/ZdechovNET/UWebCamPage.pas

    r135 r137  
    1414    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    1515  private
     16    ImageWidth: Integer;
     17    ImageHeight: Integer;
     18    function GetAll(HandlerData: THTTPHandlerData): string;
     19    function GetSingle(HandlerData: THTTPHandlerData; Id: Integer): string;
    1620    function GetVideoArchive(Id: string): string;
    1721  public
    … …  
    3539procedure TWebCamPage.DataModuleProduce(HandlerData: THTTPHandlerData);
    3640var
    37   RefreshInterval: Integer;
    38   WebCamImage: string;
    3941  DbRows: TDbRows;
    4042  I: Integer;
    4143  CameraId: Integer;
    42   IdParam: string;
    43   LastFileDate: string;
    44   ImageWidth, ImageHeight: Integer;
    45   ImageWidthThumb, ImageHeightThumb: Integer;
     44  SubPageName: string;
     45  Value: Integer;
     46  NotFound: Boolean;
    4647begin
    4748  with TWebSession(HandlerData) do begin
    … …  
    4950    with HtmlDocument.Body, THtmlString(SubItems.AddNew(THtmlString.Create)) do begin
    5051      Text := '';
     52      CameraId := -1;
     53      NotFound := False;
     54      if Request.Path.Count >= 2 then begin
     55        SubPageName := Request.Path[1];
     56        if TryStrToInt(SubPageName, Value) then
     57          CameraId := Value else
     58          NotFound := True;
     59      end;
     60      if not NotFound then begin
    5161    //for I := 0 to HandlerData.Request.Query.Count - 1 do
    5262      //Text := Text + HandlerData.Request.Query[I] + ' ';
    … …  
    5464      //HandlerData.Request.Query.Values['W'] := 'dsd';
    5565      //HandlerData.Request.Query.Values['H'] := 'dsd';
    56       if HandlerData.Request.Query.SearchKey('Id') = -1 then CameraId := -1
    57         else CameraId := StrToInt(HandlerData.Request.Query.Values['Id']);
    5866      if (HandlerData.Request.Query.SearchKey('W') = -1) then begin
    5967        ImageWidth := 640;
    … …  
    6270      end;
    6371
    64       if CameraId >= 0 then IdParam := '&amp;Id=' + IntToStr(CameraId)
    65         else IdParam := '';
    6672      Text := Text + '<table style="width: 100%"><tr><td style="width: 20%" valign="top">' +
    6773        '<strong>Velikost</strong><br/>' +
    68         '<a href="?W=160' + IdParam + '">Malá</a><br/> ' +
    69         '<a href="?W=320' + IdParam + '">Menší</a><br/> ' +
    70         '<a href="?W=640' + IdParam + '">Střední</a><br/> ' +
    71         '<a href="?W=1024' + IdParam + '">Větší</a><br/> ' +
    72         '<a href="?W=1280' + IdParam + '">Velká</a><br/><br/>';
     74        '<a href="?W=160">Malá</a><br/> ' +
     75        '<a href="?W=320">Menší</a><br/> ' +
     76        '<a href="?W=640">Střední</a><br/> ' +
     77        '<a href="?W=1024">Větší</a><br/> ' +
     78        '<a href="?W=1280">Velká</a><br/><br/>';
    7379
    7480      Text := Text + '<strong>Místní kamery</strong><br/>';
    75       Text := Text + '<a href="?W=' + IntToStr(ImageWidth) + '">Všechny</a><br/>';
     81      Text := Text + MakeLink('Všechny', NavigationLink('/kamery/?W=' + IntToStr(ImageWidth))) + '<br/>';
    7682      try
    7783        DbRows := TDbRows.Create;
    7884        Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE `Enabled`=1');
    7985        for I := 0 to DbRows.Count - 1 do begin
    80           Text := Text + '<a href="?Id=' + DbRows[I].Values['Id'] + '&amp;W=' + IntToStr(ImageWidth) +
    81           '">' + DbRows[I].Values['Name'] + '</a><br/>';
     86          Text := Text + MakeLink(DbRows[I].Values['Name'], NavigationLink(
     87            '/kamery/' + DbRows[I].Values['Id'] + '/?W=' + IntToStr(ImageWidth))) + '<br/>';
    8288        end;
    8389      finally
    … …  
    9298
    9399      if CameraId = -1 then begin
    94         try
    95           DbRows := TDbRows.Create;
    96           Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE `Enabled`=1');
    97           ImageWidthThumb := 160;
    98           for I := 0 to DbRows.Count - 1 do begin
    99             ImageHeightThumb := Round(ImageWidthThumb * StrToInt(DbRows[I].Values['Height']) / StrToInt(DbRows[I].Values['Width']));
    100             WebCamImage := 'images/webcam/' + DbRows[I].Values['ImageName'];
    101             Text := Text + '<span align="center" valign="middle" style="vertical-align: middle;">' + //DbRows[I].Values['Name'] + '<br/>' +
    102               '<a href="?Id=' + DbRows[I].Values['Id'] + '&W=' + IntToStr(ImageWidth) + '">' +
    103               '<img name="theImage" src="' + NavigationLink('/' + WebCamImage) + '" width="' +
    104             IntToStr(ImageWidthThumb) + '" height="' + IntToStr(ImageHeightThumb) + '" alt="' +
    105             DbRows[I].Values['Name'] + '"/></a></span> ';
    106           end;
    107         finally
    108           DbRows.Free;
    109         end;
    110       end else
    111       try
    112         DbRows := TDbRows.Create;
    113         Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE (`Id`=' +
    114           IntToStr(CameraId) + ') AND (`Enabled`=1)');
    115         if DbRows.Count > 0 then begin
    116 
    117           WebCamImage := 'images/webcam/' + DbRows[0].Values['ImageName'];
    118           RefreshInterval := StrToInt(DbRows[0].Values['ImagePeriod']);
    119           CameraId := StrToInt(DbRows[0].Values['Id']);
    120           ImageHeight := Round(ImageWidth * StrToInt(DbRows[0].Values['Height']) / StrToInt(DbRows[0].Values['Width']));
    121 
    122           if FileExists(WebCamImage) then begin
    123             DateTimeToString(LastFileDate, 'hh:mm:ss d.m.yyyy', FileDateToDateTime(FileAge(WebCamImage)));
    124             Text := Text + '<script language="JavaScript">' + #13#10 +
    125             '  var ImageURL= "' + NavigationLink('/' + WebCamImage) + '";' + #13#10 +
    126             '' + #13#10 +
    127             '// Force an immediate image load' + #13#10 +
    128             'var theTimer = setTimeout("reloadImage()", 1);' + #13#10 +
    129             '' + #13#10 +
    130              'function reloadImage()' + #13#10 +
    131             '{' + #13#10 +
    132             '  theDate = new Date();' + #13#10 +
    133             '  var url = ImageURL;' + #13#10 +
    134             '  url += "?dummy=";' + #13#10 +
    135             '  url += theDate.getTime().toString(10);' + #13#10 +
    136             '  // The above dummy cgi-parameter enforce a bypass of the browser image cache.' + #13#10 +
    137             '  // Here we actually load the image' + #13#10 +
    138             '  document.theImage.src = document.theImageTemp.src;' + #13#10 +
    139             '  document.theImageTemp.src = url;' + #13#10 +
    140             '' + #13#10 +
    141             '  // Reload the image every defined period' + #13#10 +
    142             '  theTimer = setTimeout("reloadImage()", ' + IntToStr(RefreshInterval * 1000) + ');' + #13#10 +
    143             '}' + #13#10 +
    144             '</script>' + #13#10 +
    145 
    146             '<br /><div align="center">' + DbRows[0].Values['Name'] + '<br/>' +
    147             '<img name="theImageTemp" src="' + NavigationLink('/' + WebCamImage) + '" width="0" height="0" alt="Temp image"/>' +
    148             '<img name="theImage" src="' + NavigationLink('/' + WebCamImage) + '" width="' + IntToStr(ImageWidth) +
    149             '" height="' + IntToStr(ImageHeight) + '" alt="' +
    150             DbRows[0].Values['Name'] + '"/></div>';
    151           end else Text := Text + '<br />Obrázek nenalezen.<br /><br />';
    152           Text := Text + '<br/><div align="center">';
    153           if LastFileDate <> '' then Text := Text + 'Aktualizace: <span id="lasttime">' +
    154             LastFileDate + '</span>, ';
    155           Text := Text + 'Perioda: ' + IntToStr(RefreshInterval) + ' sekund, Typ: ' + DbRows[0].Values['DeviceType'] + '<br />' +
    156             '<br/>' + DbRows[0].Values['Description'];
    157           Text := Text + GetVideoArchive(DbRows[0].Values['Id']) + '</div>';
    158         end else Text := Text + '<br />Id kamery nenalezeno.<br/><br>';
    159       finally
    160         DbRows.Free;
    161       end;
     100        Text := Text + GetAll(HandlerData);
     101      end else begin
     102        Text := Text + GetSingle(HandlerData, CameraId);
     103      end;
     104
    162105      Text := Text + '</td></tr></table>';
     106      end else Text := 'Stránka nenalezena.';
    163107    end;
    164108    GeneratePage(Self);
     109  end;
     110end;
     111
     112function TWebCamPage.GetAll(HandlerData: THTTPHandlerData): string;
     113var
     114  DbRows: TDbRows;
     115  I: Integer;
     116  ImageWidthThumb: Integer;
     117  ImageHeightThumb: Integer;
     118  WebCamImage: string;
     119begin
     120  Result := '';
     121  with TWebSession(HandlerData) do
     122  try
     123    DbRows := TDbRows.Create;
     124    Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE `Enabled`=1');
     125    ImageWidthThumb := 160;
     126    for I := 0 to DbRows.Count - 1 do begin
     127      ImageHeightThumb := Round(ImageWidthThumb * StrToInt(DbRows[I].Values['Height']) / StrToInt(DbRows[I].Values['Width']));
     128      WebCamImage := 'images/webcam/' + DbRows[I].Values['ImageName'];
     129      Result := Result + '<span align="center" valign="middle" style="vertical-align: middle;">' + //DbRows[I].Values['Name'] + '<br/>' +
     130        '<a href="' + NavigationLink('/kamery/' + DbRows[I].Values['Id'] + '/?W=' + IntToStr(ImageWidth)) + '">' +
     131        '<img name="theImage" src="' + NavigationLink('/' + WebCamImage) + '" width="' +
     132        IntToStr(ImageWidthThumb) + '" height="' + IntToStr(ImageHeightThumb) + '" alt="' +
     133        DbRows[I].Values['Name'] + '"/></a></span> ';
     134    end;
     135  finally
     136    DbRows.Free;
     137  end;
     138end;
     139
     140function TWebCamPage.GetSingle(HandlerData: THTTPHandlerData; Id: Integer): string;
     141var
     142  DbRows: TDbRows;
     143  I: Integer;
     144  WebCamImage: string;
     145  RefreshInterval: Integer;
     146  LastFileDate: string;
     147begin
     148  Result := '';
     149  with TWebSession(HandlerData) do
     150  try
     151    DbRows := TDbRows.Create;
     152    Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE (`Id`=' +
     153      IntToStr(Id) + ') AND (`Enabled`=1)');
     154    if DbRows.Count > 0 then begin
     155      WebCamImage := 'images/webcam/' + DbRows[0].Values['ImageName'];
     156      RefreshInterval := StrToInt(DbRows[0].Values['ImagePeriod']);
     157      ImageHeight := Round(ImageWidth * StrToInt(DbRows[0].Values['Height']) / StrToInt(DbRows[0].Values['Width']));
     158
     159      if FileExists(WebCamImage) then begin
     160        DateTimeToString(LastFileDate, 'hh:mm:ss d.m.yyyy', FileDateToDateTime(FileAge(WebCamImage)));
     161        Result := Result + '<script language="JavaScript">' + #13#10 +
     162          '  var ImageURL= "' + NavigationLink('/' + WebCamImage) + '";' + #13#10 +
     163          '' + #13#10 +
     164          '// Force an immediate image load' + #13#10 +
     165          'var theTimer = setTimeout("reloadImage()", 1);' + #13#10 +
     166          '' + #13#10 +
     167          'function reloadImage()' + #13#10 +
     168          '{' + #13#10 +
     169          '  theDate = new Date();' + #13#10 +
     170          '  var url = ImageURL;' + #13#10 +
     171          '  url += "?dummy=";' + #13#10 +
     172          '  url += theDate.getTime().toString(10);' + #13#10 +
     173          '  // The above dummy cgi-parameter enforce a bypass of the browser image cache.' + #13#10 +
     174          '  // Here we actually load the image' + #13#10 +
     175          '  document.theImage.src = document.theImageTemp.src;' + #13#10 +
     176          '  document.theImageTemp.src = url;' + #13#10 +
     177          '' + #13#10 +
     178          '  // Reload the image every defined period' + #13#10 +
     179          '  theTimer = setTimeout("reloadImage()", ' + IntToStr(RefreshInterval * 1000) + ');' + #13#10 +
     180          '}' + #13#10 +
     181          '</script>' + #13#10 +
     182
     183          '<br /><div align="center">' + DbRows[0].Values['Name'] + '<br/>' +
     184          '<img name="theImageTemp" src="' + NavigationLink('/' + WebCamImage) + '" width="0" height="0" alt="Temp image"/>' +
     185          '<img name="theImage" src="' + NavigationLink('/' + WebCamImage) + '" width="' + IntToStr(ImageWidth) +
     186          '" height="' + IntToStr(ImageHeight) + '" alt="' +
     187          DbRows[0].Values['Name'] + '"/></div>';
     188      end else Result := Result + '<br />Obrázek nenalezen.<br /><br />';
     189      Result := Result + '<br/><div align="center">';
     190      if LastFileDate <> '' then Result := Result + 'Aktualizace: <span id="lasttime">' +
     191        LastFileDate + '</span>, ';
     192      Result := Result + 'Perioda: ' + IntToStr(RefreshInterval) + ' sekund, Typ: ' + DbRows[0].Values['DeviceType'] + '<br />' +
     193        '<br/>' + DbRows[0].Values['Description'];
     194      Result := Result + GetVideoArchive(DbRows[0].Values['Id']) + '</div>';
     195    end else Result := Result + '<br />Id kamery nenalezeno.<br/><br>';
     196  finally
     197    DbRows.Free;
    165198  end;
    166199end;
    … …  
    180213  VideoPathFormat := 'images/webcam_archive/%s/%s/video.mp4';
    181214  Items := TStringList.Create;
    182   Date := Now - OneDay;
    183   repeat
    184     DateStr := FormatDateTime('yyyy-mm-dd', Date);
    185     Video := Format(VideoPathFormat, [DateStr, Id]);
    186     if FileExists(Video) then begin
    187       Items.Add(DateStr + Items.NameValueSeparator + Video);
    188       Date := Date - OneDay;
    189       Continue;
    190     end else Break;
    191   until False;
    192 
    193   if Items.Count > 0 then begin
    194     Result := '<br/>Video archív: <select name="dates" id="dates">';
    195     for I := 0 to Items.Count - 1 do begin
    196       Result := Result + '<option value="' + NavigationLink('/' + Items.ValueFromIndex[I]) + '">' + Items.Names[I] + '</option>';
     215  try
     216    Date := Now - OneDay;
     217    repeat
     218      DateStr := FormatDateTime('yyyy-mm-dd', Date);
     219      Video := Format(VideoPathFormat, [DateStr, Id]);
     220      if FileExists(Video) then begin
     221        Items.Add(DateStr + Items.NameValueSeparator + Video);
     222        Date := Date - OneDay;
     223        Continue;
     224      end else Break;
     225    until False;
     226
     227    if Items.Count > 0 then begin
     228      Result := '<br/>Video archív: <select name="dates" id="dates">';
     229      for I := 0 to Items.Count - 1 do begin
     230        Result := Result + '<option value="' + NavigationLink('/' + Items.ValueFromIndex[I]) + '">' + Items.Names[I] + '</option>';
     231      end;
     232      Result := Result + '</select>';
     233      Result := Result + ' <button onclick="var element = document.getElementById(''dates''); window.open(element.value, ''_blank'')">Zobrazit</button>';
    197234    end;
    198     Result := Result + '</select>';
    199     Result := Result + ' <button onclick="var element = document.getElementById(''dates''); window.open(element.value, ''_blank'')">Zobrazit</button>';
    200   end;
    201 
    202   Items.Free;
     235  finally
     236    Items.Free;
     237  end;
    203238end;
    204239
Note: See TracChangeset for help on using the changeset viewer.