Changeset 137 for trunk/Modules


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
Files:
2 added
21 edited

Legend:

Unmodified
Added
Removed

  • trunk/Modules/Base/UModuleBase.pas

    r107 r137  
    11unit UModuleBase;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    1715  private
    1816    PageAdmin: TWebPage;
    19     FGeneratePage: TGeneratePageEvent;
     17    FOnGeneratePage: TGeneratePageEvent;
    2018  public
    2119    Session: TWebSession;
    … …  
    2927    procedure Uninstall; override;
    3028    procedure Upgrade; override;
    31     property GeneratePage: TGeneratePageEvent read FGeneratePage write FGeneratePage;
     29    property OnGeneratePage: TGeneratePageEvent read FOnGeneratePage write FOnGeneratePage;
    3230  end;
    3331
    … …  
    5351destructor TModuleBase.Destroy;
    5452begin
    55   inherited Destroy;
     53  inherited;
    5654end;
    5755

  • trunk/Modules/Finance/UModuleFinance.pas

    r132 r137  
    11unit UModuleFinance;
    2 
    3 {$mode delphi}
    42
    53interface

  • trunk/Modules/Finance/UPageFinance.pas

    r101 r137  
    11unit UPageFinance;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    2321  WebPageFinance: TWebPageFinance;
    2422
     23
    2524implementation
    2625
    … …  
    3130procedure TWebPageFinance.DataModuleProduce(HandlerData: THTTPHandlerData);
    3231begin
    33 
    3432end;
    3533

  • trunk/Modules/IS/UModuleIS.pas

    r105 r137  
    11unit UModuleIS;
    2 
    3 {$mode delphi}
    42
    53interface

  • trunk/Modules/Network/UModuleNetwork.pas

    r132 r137  
    11unit UModuleNetwork;
    2 
    3 {$mode delphi}
    42
    53interface

  • trunk/Modules/Network/UPageNetwork.pas

    r101 r137  
    11unit UPageNetwork;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    1917  WebPageNetwork: TWebPageNetwork;
    2018
     19
    2120implementation
    2221

  • trunk/Modules/News/UModuleNews.pas

    r107 r137  
    11unit UModuleNews;
    2 
    3 {$mode delphi}
    42
    53interface
    64
    75uses
    8   Classes, SysUtils, UModularSystem, SpecializedDictionary, UModuleBase, UNews,
    9   UHTTPServer, UModuleUser;
     6  Classes, SysUtils, UModularSystem, UModuleBase, UNews, UHTTPServer, UModuleUser;
    107
    118type
    … …  
    8279var
    8380  DbRows: TDbRows;
    84   Data: TDictionaryStringString;
    8581begin
    8682  try
    8783    DbRows := TDbRows.Create;
    88     Data := TDictionaryStringString.Create;
    8984
    9085    Core.CommonDatabase.Query(DbRows,
    … …  
    125120    '  ADD CONSTRAINT `News_ibfk_1` FOREIGN KEY (`Category`) REFERENCES `NewsCategory` (`Id`);');
    126121  finally
    127     Data.Free;
    128122    DbRows.Free;
    129123  end;
    130   inherited Install;
     124  inherited;
    131125end;
    132126
    … …  
    135129  DbRows: TDbRows;
    136130begin
    137   inherited Uninstall;
     131  inherited;
    138132  try
    139133    DbRows := TDbRows.Create;

  • trunk/Modules/News/UNews.pas

    r132 r137  
    11unit UNews;
    22
    3 {mode delphi}
    4 
    53interface
    64
    75uses
    8   Classes, SysUtils, USqlDatabase, UModuleUser, UUtils, fgl, UWebSession,
    9   UHTTPServer, UModuleBase, SpecializedList;
     6  Classes, SysUtils, USqlDatabase, UModuleUser, UUtils, Generics.Collections, UWebSession,
     7  UHTTPServer, UModuleBase, UCommon;
    108
    119type
    … …  
    1917  end;
    2018
    21   TNewsSettingItems = class(TFPGObjectList<TNewsSettingItem>)
     19  TNewsSettingItems = class(TObjectList<TNewsSettingItem>)
    2220  end;
    2321
    … …  
    4442
    4543
    46 
    4744implementation
    4845
    … …  
    9188  J: Integer;
    9289  Author: string;
    93   Enclosures: TListString;
     90  Enclosures: TStringArray;
    9491begin
    9592  //global Database, NewsCategoryNames, NewsCountPerCategory, UploadedFilesFolder;
    … …  
    128125      if DbRows[I].Values['Enclosure'] <> '' then begin
    129126        Output := Output + '<br />Přílohy: ';
    130         try
    131           Enclosures := TListString.Create;
    132           Enclosures.Explode(DbRows[I].Values['Enclosure'], ';', StrToStr);
    133           for J := 0 to Enclosures.Count - 1  do begin
    134             if FileExists(UploadedFilesFolder + Enclosures[J]) then
    135               Output := Output + ' <a href="' + UploadedFilesFolder + Enclosures[J] +
    136               '">' + Enclosures[J] + '</a>';
    137           end;
    138         finally
    139           Enclosures.Free;
     127        Enclosures := Explode(';', DbRows[I].Values['Enclosure']);
     128        for J := 0 to Length(Enclosures) - 1  do begin
     129          if FileExists(UploadedFilesFolder + Enclosures[J]) then
     130            Output := Output + ' <a href="' + UploadedFilesFolder + Enclosures[J] +
     131            '">' + Enclosures[J] + '</a>';
    140132        end;
    141133      end;

  • trunk/Modules/Portal/UModulePortal.pas

    r132 r137  
    11unit UModulePortal;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    6361  BeforeStart;
    6462  ModuleBase := TModuleBase(Manager.FindModuleByName('Base'));
    65   ModuleBase.GeneratePage := GeneratePage;
     63  ModuleBase.OnGeneratePage := GeneratePage;
    6664  WebPagePortal := TWebPagePortal.Create(nil);
    6765  ModuleBase.Pages.RegisterPage(WebPagePortal, '');

  • trunk/Modules/Portal/UPagePortal.pas

    r132 r137  
    11unit UPagePortal;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    3230var
    3331  WebPagePortal: TWebPagePortal;
     32
    3433
    3534implementation

  • trunk/Modules/System/UModuleSystem.pas

    r105 r137  
    11unit UModuleSystem;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    6361destructor TModuleSystem.Destroy;
    6462begin
    65   inherited Destroy;
     63  inherited;
    6664end;
    6765
    … …  
    7472  try
    7573    DbRows := TDbRows.Create;
    76     Core.CommonDatabase.Select(DbRows, 'SystemModule', 'Name, Installed');
     74    Core.CommonDatabase.Select(DbRows, 'SystemModule', '`Name`, `Installed`');
    7775    for I := 0 to DbRows.Count - 1 do
    7876    with DbRows[I] do begin
    … …  
    102100  try
    103101    DbRows := TDbRows.Create;
    104   Core.CommonDatabase.Query(DbRows,
    105     'CREATE TABLE IF NOT EXISTS `SystemModule` (' +
    106     '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
    107     '  `Name` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    108     '  `Title` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    109     '  `Creator` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    110     '  `Version` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    111     '  `License` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    112     '  `Installed` int(11) NOT NULL,' +
    113     '  `Description` text COLLATE utf8_czech_ci NOT NULL,' +
    114     '  `Dependencies` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    115     '  PRIMARY KEY (`Id`)' +
    116     ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     102    Core.CommonDatabase.Query(DbRows,
     103      'CREATE TABLE IF NOT EXISTS `SystemModule` (' +
     104      '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     105      '  `Name` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     106      '  `Title` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     107      '  `Creator` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     108      '  `Version` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     109      '  `License` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     110      '  `Installed` int(11) NOT NULL,' +
     111      '  `Description` text COLLATE utf8_czech_ci NOT NULL,' +
     112      '  `Dependencies` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     113      '  PRIMARY KEY (`Id`)' +
     114      ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
    117115  finally
    118116    DbRows.Free;
    119117  end;
    120118  UpdateModuleList;
    121   inherited Install;
     119  inherited;
    122120end;
    123121
    … …  
    126124  DbRows: TDbRows;
    127125begin
    128   inherited Uninstall;
     126  inherited;
    129127  try
    130128    DbRows := TDbRows.Create;
    … …  
    137135procedure TModuleSystem.Upgrade;
    138136begin
    139   inherited Upgrade;
     137  inherited;
    140138end;
    141139

  • trunk/Modules/TV/UModuleTV.pas

    r132 r137  
    11unit UModuleTV;
    2 
    3 {$mode delphi}
    42
    53interface

  • trunk/Modules/TV/UPageTV.pas

    r105 r137  
    11unit UPageTV;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    2422var
    2523  WebPageTV: TWebPageTV;
     24
    2625
    2726implementation

  • trunk/Modules/TV/UPlaylist.pas

    r99 r137  
    11unit UPlaylist;
    2 
    3 {$mode delphi}
    42
    53interface

  • trunk/Modules/User/UModuleUser.pas

    r132 r137  
    11unit UModuleUser;
    2 
    3 {$mode delphi}
    42
    53interface

  • trunk/Modules/User/UUser.pas

    r108 r137  
    11unit UUser;
    2 
    3 {$mode Delphi}{$H+}
    42
    53interface
    … …  
    4947  end;
    5048
     49
    5150implementation
    5251

  • trunk/Modules/User/UUserControlPage.pas

    r105 r137  
    11unit UUserControlPage;
    2 
    3 {$mode delphi}
    42
    53interface
    … …  
    2725var
    2826  UserControlPage: TUserControlPage;
     27
    2928
    3029implementation

  • 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.