Changeset 137
- Timestamp:
- Sep 9, 2022, 1:16:58 AM (2 years ago)
- Location:
- trunk
- Files:
-
- 8 added
- 3 deleted
- 109 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Application/UWebObjects.pas
r132 r137 1 1 unit UWebObjects; 2 2 3 {$mode delphi}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, UHtmlClasses, UXmlClasses, SpecializedDictionary, fgl; 6 Classes, SysUtils, UHtmlClasses, UXmlClasses, SpecializedDictionary, 7 Generics.Collections; 9 8 10 9 type … … 34 33 { TQueryFormItemList } 35 34 36 TQueryFormItemList = class(T FPGObjectList<TQueryFormItem>)35 TQueryFormItemList = class(TObjectList<TQueryFormItem>) 37 36 function FindByName(AValue: string): TQueryFormItem; 38 37 end; … … 49 48 end; 50 49 51 TQueryFormGroups = class(T FPGObjectList<TQueryFormGroup>)50 TQueryFormGroups = class(TObjectList<TQueryFormGroup>) 52 51 end; 53 52 … … 57 56 end; 58 57 59 TQueryActions = class(T FPGObjectList<TQueryAction>)58 TQueryActions = class(TObjectList<TQueryAction>) 60 59 end; 61 60 -
trunk/Application/UWebSession.pas
r130 r137 1 1 unit UWebSession; 2 3 {$mode delphi}4 2 5 3 interface … … 70 68 begin 71 69 with TModuleBase(ModuleManager.FindModuleByName('Base')) do 72 if Assigned( GeneratePage) thenGeneratePage(Self, Page)70 if Assigned(OnGeneratePage) then OnGeneratePage(Self, Page) 73 71 else GeneratePageDefault(Self, Page); 74 72 end; -
trunk/Common/UUtils.pas
r81 r137 1 1 unit UUtils; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 17 15 function HumanDate(Date: TDateTime): string; 18 16 function PagesList(URL: string; Page, TotalCount, CountPerPage: Integer): string; 17 19 18 20 19 implementation … … 137 136 end; 138 137 139 140 initialization141 142 finalization143 144 138 end. -
trunk/Modules/Base/UModuleBase.pas
r107 r137 1 1 unit UModuleBase; 2 3 {$mode delphi}4 2 5 3 interface … … 17 15 private 18 16 PageAdmin: TWebPage; 19 F GeneratePage: TGeneratePageEvent;17 FOnGeneratePage: TGeneratePageEvent; 20 18 public 21 19 Session: TWebSession; … … 29 27 procedure Uninstall; override; 30 28 procedure Upgrade; override; 31 property GeneratePage: TGeneratePageEvent read FGeneratePage write FGeneratePage;29 property OnGeneratePage: TGeneratePageEvent read FOnGeneratePage write FOnGeneratePage; 32 30 end; 33 31 … … 53 51 destructor TModuleBase.Destroy; 54 52 begin 55 inherited Destroy;53 inherited; 56 54 end; 57 55 -
trunk/Modules/Finance/UModuleFinance.pas
r132 r137 1 1 unit UModuleFinance; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Modules/Finance/UPageFinance.pas
r101 r137 1 1 unit UPageFinance; 2 3 {$mode delphi}4 2 5 3 interface … … 23 21 WebPageFinance: TWebPageFinance; 24 22 23 25 24 implementation 26 25 … … 31 30 procedure TWebPageFinance.DataModuleProduce(HandlerData: THTTPHandlerData); 32 31 begin 33 34 32 end; 35 33 -
trunk/Modules/IS/UModuleIS.pas
r105 r137 1 1 unit UModuleIS; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Modules/Network/UModuleNetwork.pas
r132 r137 1 1 unit UModuleNetwork; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Modules/Network/UPageNetwork.pas
r101 r137 1 1 unit UPageNetwork; 2 3 {$mode delphi}4 2 5 3 interface … … 19 17 WebPageNetwork: TWebPageNetwork; 20 18 19 21 20 implementation 22 21 -
trunk/Modules/News/UModuleNews.pas
r107 r137 1 1 unit UModuleNews; 2 3 {$mode delphi}4 2 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, UModularSystem, SpecializedDictionary, UModuleBase, UNews, 9 UHTTPServer, UModuleUser; 6 Classes, SysUtils, UModularSystem, UModuleBase, UNews, UHTTPServer, UModuleUser; 10 7 11 8 type … … 82 79 var 83 80 DbRows: TDbRows; 84 Data: TDictionaryStringString;85 81 begin 86 82 try 87 83 DbRows := TDbRows.Create; 88 Data := TDictionaryStringString.Create;89 84 90 85 Core.CommonDatabase.Query(DbRows, … … 125 120 ' ADD CONSTRAINT `News_ibfk_1` FOREIGN KEY (`Category`) REFERENCES `NewsCategory` (`Id`);'); 126 121 finally 127 Data.Free;128 122 DbRows.Free; 129 123 end; 130 inherited Install;124 inherited; 131 125 end; 132 126 … … 135 129 DbRows: TDbRows; 136 130 begin 137 inherited Uninstall;131 inherited; 138 132 try 139 133 DbRows := TDbRows.Create; -
trunk/Modules/News/UNews.pas
r132 r137 1 1 unit UNews; 2 2 3 {mode delphi}4 5 3 interface 6 4 7 5 uses 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; 10 8 11 9 type … … 19 17 end; 20 18 21 TNewsSettingItems = class(T FPGObjectList<TNewsSettingItem>)19 TNewsSettingItems = class(TObjectList<TNewsSettingItem>) 22 20 end; 23 21 … … 44 42 45 43 46 47 44 implementation 48 45 … … 91 88 J: Integer; 92 89 Author: string; 93 Enclosures: T ListString;90 Enclosures: TStringArray; 94 91 begin 95 92 //global Database, NewsCategoryNames, NewsCountPerCategory, UploadedFilesFolder; … … 128 125 if DbRows[I].Values['Enclosure'] <> '' then begin 129 126 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>'; 140 132 end; 141 133 end; -
trunk/Modules/Portal/UModulePortal.pas
r132 r137 1 1 unit UModulePortal; 2 3 {$mode delphi}4 2 5 3 interface … … 63 61 BeforeStart; 64 62 ModuleBase := TModuleBase(Manager.FindModuleByName('Base')); 65 ModuleBase. GeneratePage := GeneratePage;63 ModuleBase.OnGeneratePage := GeneratePage; 66 64 WebPagePortal := TWebPagePortal.Create(nil); 67 65 ModuleBase.Pages.RegisterPage(WebPagePortal, ''); -
trunk/Modules/Portal/UPagePortal.pas
r132 r137 1 1 unit UPagePortal; 2 3 {$mode delphi}4 2 5 3 interface … … 32 30 var 33 31 WebPagePortal: TWebPagePortal; 32 34 33 35 34 implementation -
trunk/Modules/System/UModuleSystem.pas
r105 r137 1 1 unit UModuleSystem; 2 3 {$mode delphi}4 2 5 3 interface … … 63 61 destructor TModuleSystem.Destroy; 64 62 begin 65 inherited Destroy;63 inherited; 66 64 end; 67 65 … … 74 72 try 75 73 DbRows := TDbRows.Create; 76 Core.CommonDatabase.Select(DbRows, 'SystemModule', ' Name, Installed');74 Core.CommonDatabase.Select(DbRows, 'SystemModule', '`Name`, `Installed`'); 77 75 for I := 0 to DbRows.Count - 1 do 78 76 with DbRows[I] do begin … … 102 100 try 103 101 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 ;'); 117 115 finally 118 116 DbRows.Free; 119 117 end; 120 118 UpdateModuleList; 121 inherited Install;119 inherited; 122 120 end; 123 121 … … 126 124 DbRows: TDbRows; 127 125 begin 128 inherited Uninstall;126 inherited; 129 127 try 130 128 DbRows := TDbRows.Create; … … 137 135 procedure TModuleSystem.Upgrade; 138 136 begin 139 inherited Upgrade;137 inherited; 140 138 end; 141 139 -
trunk/Modules/TV/UModuleTV.pas
r132 r137 1 1 unit UModuleTV; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Modules/TV/UPageTV.pas
r105 r137 1 1 unit UPageTV; 2 3 {$mode delphi}4 2 5 3 interface … … 24 22 var 25 23 WebPageTV: TWebPageTV; 24 26 25 27 26 implementation -
trunk/Modules/TV/UPlaylist.pas
r99 r137 1 1 unit UPlaylist; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Modules/User/UModuleUser.pas
r132 r137 1 1 unit UModuleUser; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Modules/User/UUser.pas
r108 r137 1 1 unit UUser; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 49 47 end; 50 48 49 51 50 implementation 52 51 -
trunk/Modules/User/UUserControlPage.pas
r105 r137 1 1 unit UUserControlPage; 2 3 {$mode delphi}4 2 5 3 interface … … 27 25 var 28 26 UserControlPage: TUserControlPage; 27 29 28 30 29 implementation -
trunk/Modules/ZdechovNET/UAboutPage.pas
r135 r137 103 103 end; 104 104 105 initialization106 107 105 end. 108 106 -
trunk/Modules/ZdechovNET/UIPTVPage.pas
r135 r137 4 4 5 5 uses 6 Classes, SysUtils, FileUtil, UWebPage, UHTTPServer, UModuleUser, fgl; 6 Classes, SysUtils, FileUtil, UWebPage, UHTTPServer, UModuleUser, 7 Generics.Collections; 7 8 8 9 type … … 18 19 { TChannels } 19 20 20 TChannels = class(T FPGObjectList<TChannel>)21 TChannels = class(TObjectList<TChannel>) 21 22 function AddNew(Name: string; Groups: TChannelGroups): TChannel; 22 23 function GetNamesByGroup(Group: TChannelGroup): string; -
trunk/Modules/ZdechovNET/UModuleZdechovNET.pas
r135 r137 4 4 5 5 uses 6 Classes, SysUtils, UModularSystem, UWebPage, 6 Classes, SysUtils, UModularSystem, UWebPage, URobotsPage, 7 7 UWebSession, DateUtils, UModuleBase, UModuleUser, UIPTVPage, 8 8 UInternetPage, UHostingPage, UHistoryPage, UDocumentsPage, UVoIPPage, … … 30 30 AboutPage: TAboutPage; 31 31 IPTVPage: TIPTVPage; 32 RobotsPage: TRobotsPage; 32 33 procedure Footer(Session: TWebSession); 33 34 procedure GeneratePage(ASession: TWebSession; Page: TWebPage); … … 36 37 ModuleBase: TModuleBase; 37 38 ModuleUser: TModuleUser; 39 Raw: Boolean; 38 40 constructor Create(Owner: TComponent); override; 39 41 destructor Destroy; override; … … 74 76 BeforeStart; 75 77 ModuleBase := TModuleBase(Manager.FindModuleByName('Base')); 76 ModuleBase. GeneratePage := GeneratePage;78 ModuleBase.OnGeneratePage := GeneratePage; 77 79 ModuleUser := TModuleUser(Manager.FindModuleByName('User')); 78 80 with ModuleBase, Pages do begin 79 // GeneratePage :=GeneratePage;81 //OnGeneratePage := OnGeneratePage; 80 82 InternetPage := TInternetPage.Create(nil); 81 83 InternetPage.ModuleUser := ModuleUser; … … 120 122 IPTVPage.ModuleUser := ModuleUser; 121 123 RegisterPage(IPTVPage, 'televize'); 124 RobotsPage := TRobotsPage.Create(nil); 125 RobotsPage.ModuleUser := ModuleUser; 126 RegisterPage(RobotsPage, 'robots.txt'); 122 127 end; 123 128 AfterStart; … … 156 161 UnregisterPage(ProjectsPage); 157 162 FreeAndNil(ProjectsPage); 163 UnregisterPage(RobotsPage); 164 FreeAndNil(RobotsPage); 158 165 end; 159 166 ModuleBase := nil; … … 242 249 begin 243 250 inherited; 244 ModuleBase. GeneratePage := nil;251 ModuleBase.OnGeneratePage := nil; 245 252 try 246 253 DbRows := TDbRows.Create; … … 348 355 begin 349 356 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')); 355 365 356 366 TitleTag := THtmlString.Create; … … 370 380 end; 371 381 end; 382 end; 372 383 end; 373 384 -
trunk/Modules/ZdechovNET/UWebCamPage.pas
r135 r137 14 14 procedure DataModuleProduce(HandlerData: THTTPHandlerData); 15 15 private 16 ImageWidth: Integer; 17 ImageHeight: Integer; 18 function GetAll(HandlerData: THTTPHandlerData): string; 19 function GetSingle(HandlerData: THTTPHandlerData; Id: Integer): string; 16 20 function GetVideoArchive(Id: string): string; 17 21 public … … 35 39 procedure TWebCamPage.DataModuleProduce(HandlerData: THTTPHandlerData); 36 40 var 37 RefreshInterval: Integer;38 WebCamImage: string;39 41 DbRows: TDbRows; 40 42 I: Integer; 41 43 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; 46 47 begin 47 48 with TWebSession(HandlerData) do begin … … 49 50 with HtmlDocument.Body, THtmlString(SubItems.AddNew(THtmlString.Create)) do begin 50 51 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 51 61 //for I := 0 to HandlerData.Request.Query.Count - 1 do 52 62 //Text := Text + HandlerData.Request.Query[I] + ' '; … … 54 64 //HandlerData.Request.Query.Values['W'] := 'dsd'; 55 65 //HandlerData.Request.Query.Values['H'] := 'dsd'; 56 if HandlerData.Request.Query.SearchKey('Id') = -1 then CameraId := -157 else CameraId := StrToInt(HandlerData.Request.Query.Values['Id']);58 66 if (HandlerData.Request.Query.SearchKey('W') = -1) then begin 59 67 ImageWidth := 640; … … 62 70 end; 63 71 64 if CameraId >= 0 then IdParam := '&Id=' + IntToStr(CameraId)65 else IdParam := '';66 72 Text := Text + '<table style="width: 100%"><tr><td style="width: 20%" valign="top">' + 67 73 '<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/>'; 73 79 74 80 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/>'; 76 82 try 77 83 DbRows := TDbRows.Create; 78 84 Database.Query(DbRows, 'SELECT * FROM `Webcam` WHERE `Enabled`=1'); 79 85 for I := 0 to DbRows.Count - 1 do begin 80 Text := Text + '<a href="?Id=' + DbRows[I].Values['Id'] + '&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/>'; 82 88 end; 83 89 finally … … 92 98 93 99 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 162 105 Text := Text + '</td></tr></table>'; 106 end else Text := 'Stránka nenalezena.'; 163 107 end; 164 108 GeneratePage(Self); 109 end; 110 end; 111 112 function TWebCamPage.GetAll(HandlerData: THTTPHandlerData): string; 113 var 114 DbRows: TDbRows; 115 I: Integer; 116 ImageWidthThumb: Integer; 117 ImageHeightThumb: Integer; 118 WebCamImage: string; 119 begin 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; 138 end; 139 140 function TWebCamPage.GetSingle(HandlerData: THTTPHandlerData; Id: Integer): string; 141 var 142 DbRows: TDbRows; 143 I: Integer; 144 WebCamImage: string; 145 RefreshInterval: Integer; 146 LastFileDate: string; 147 begin 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; 165 198 end; 166 199 end; … … 180 213 VideoPathFormat := 'images/webcam_archive/%s/%s/video.mp4'; 181 214 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>'; 197 234 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; 203 238 end; 204 239 -
trunk/Packages/Common/Common.lpk
r131 r137 33 33 <Other> 34 34 <CompilerMessages> 35 <IgnoredMessages idx6058="True" idx50 24="True" idx3124="True" idx3123="True"/>35 <IgnoredMessages idx6058="True" idx5071="True" idx5024="True" idx3124="True" idx3123="True"/> 36 36 </CompilerMessages> 37 37 </Other> … … 41 41 Source: https://svn.zdechov.net/PascalClassLibrary/Common/"/> 42 42 <License Value="Copy left."/> 43 <Version Minor=" 9"/>44 <Files Count=" 29">43 <Version Minor="10"/> 44 <Files Count="31"> 45 45 <Item1> 46 46 <Filename Value="StopWatch.pas"/> … … 171 171 <UnitName Value="UPixelPointer"/> 172 172 </Item29> 173 <Item30> 174 <Filename Value="UDataFile.pas"/> 175 <UnitName Value="UDataFile"/> 176 </Item30> 177 <Item31> 178 <Filename Value="UTestCase.pas"/> 179 <UnitName Value="UTestCase"/> 180 </Item31> 173 181 </Files> 174 182 <CompatibilityMode Value="True"/> -
trunk/Packages/Common/Common.pas
r131 r137 14 14 UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas, 15 15 UGeometric, UTranslator, ULanguages, UFormAbout, UAboutDialog, 16 UPixelPointer, LazarusPackageIntf;16 UPixelPointer, UDataFile, UTestCase, LazarusPackageIntf; 17 17 18 18 implementation -
trunk/Packages/Common/StopWatch.pas
r89 r137 5 5 6 6 uses 7 {$IFDEF W indows}Windows,{$ENDIF}7 {$IFDEF WINDOWS}Windows,{$ENDIF} 8 8 SysUtils, DateUtils; 9 9 … … 32 32 end; 33 33 34 34 35 implementation 35 36 … … 40 41 fIsRunning := False; 41 42 42 {$IFDEF W indows}43 {$IFDEF WINDOWS} 43 44 fIsHighResolution := QueryPerformanceFrequency(fFrequency) ; 44 45 {$ELSE} -
trunk/Packages/Common/UAboutDialog.pas
r131 r137 1 1 unit UAboutDialog; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/Common/UApplicationInfo.pas
r131 r137 1 1 unit UApplicationInfo; 2 3 {$mode delphi}4 2 5 3 interface … … 59 57 procedure Register; 60 58 59 61 60 implementation 62 61 -
trunk/Packages/Common/UCommon.pas
r131 r137 1 1 unit UCommon; 2 3 {$mode delphi}4 2 5 3 interface … … 34 32 DLLHandle1: HModule; 35 33 34 {$IFDEF WINDOWS} 35 GetUserNameEx: procedure (NameFormat: DWORD; 36 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 37 {$ENDIF} 38 36 39 const 37 40 clLightBlue = TColor($FF8080); 38 41 clLightGreen = TColor($80FF80); 39 42 clLightRed = TColor($8080FF); 40 41 {$IFDEF WINDOWS}42 GetUserNameEx: procedure (NameFormat: DWORD;43 lpNameBuffer: LPSTR; nSize: PULONG); stdcall;44 {$ENDIF}45 43 46 44 function AddLeadingZeroes(const aNumber, Length : integer) : string; -
trunk/Packages/Common/UDebugLog.pas
r131 r137 1 1 unit UDebugLog; 2 3 {$mode delphi}4 2 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, FileUtil, fgl, SyncObjs;6 Classes, SysUtils, FileUtil, Generics.Collections, SyncObjs; 9 7 10 8 type … … 15 13 Group: string; 16 14 Text: string; 15 end; 16 17 TDebugLogItems = class(TObjectList<TDebugLogItem>) 17 18 end; 18 19 … … 29 30 procedure SetMaxCount(const AValue: Integer); 30 31 public 31 Items: T FPGObjectList<TDebugLogItem>;32 Items: TDebugLogItems; 32 33 Lock: TCriticalSection; 33 34 procedure Add(Text: string; Group: string = ''); … … 44 45 45 46 procedure Register; 47 46 48 47 49 implementation … … 117 119 begin 118 120 inherited; 119 Items := T FPGObjectList<TDebugLogItem>.Create;121 Items := TDebugLogItems.Create; 120 122 Lock := TCriticalSection.Create; 121 123 MaxCount := 100; … … 126 128 destructor TDebugLog.Destroy; 127 129 begin 128 Items.Free;129 Lock.Free;130 FreeAndNil(Items); 131 FreeAndNil(Lock); 130 132 inherited; 131 133 end; -
trunk/Packages/Common/UDelay.pas
r84 r137 1 1 unit UDelay; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/Common/UFindFile.pas
r131 r137 35 35 private 36 36 s : TStringList; 37 38 37 fSubFolder : boolean; 39 38 fAttr: TFileAttrib; 40 39 fPath : string; 41 40 fFileMask : string; 42 43 41 procedure SetPath(Value: string); 44 42 procedure FileSearch(const inPath : string); … … 46 44 constructor Create(AOwner: TComponent); override; 47 45 destructor Destroy; override; 48 49 46 function SearchForFiles: TStringList; 50 47 published … … 64 61 65 62 procedure Register; 63 66 64 67 65 implementation … … 87 85 begin 88 86 s.Free; 89 inherited Destroy;87 inherited; 90 88 end; 91 89 -
trunk/Packages/Common/UFormAbout.pas
r131 r137 1 1 unit UFormAbout; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/Common/UGeometric.pas
r131 r137 1 1 unit UGeometric; 2 3 {$mode delphi}4 2 5 3 interface … … 26 24 function RectEnlarge(Rect: TRect; Value: Integer): TRect; 27 25 function ShiftRect(ARect: TRect; Delta: TPoint): TRect; 26 28 27 29 28 implementation -
trunk/Packages/Common/UJobProgressView.pas
r131 r137 1 1 unit UJobProgressView; 2 3 {$MODE Delphi}4 2 5 3 interface … … 7 5 uses 8 6 SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs, 9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, fgl, UThreading, Math,7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, UThreading, Math, 10 8 DateUtils; 11 9 … … 71 69 end; 72 70 73 TJobs = class(T FPGObjectList<TJob>)71 TJobs = class(TObjectList<TJob>) 74 72 end; 75 73 … … 163 161 resourcestring 164 162 SExecuted = 'Executed'; 163 165 164 166 165 implementation … … 642 641 begin 643 642 FLock.Free; 644 inherited Destroy;643 inherited; 645 644 end; 646 645 -
trunk/Packages/Common/ULanguages.pas
r131 r137 1 1 unit ULanguages; 2 2 3 {$mode delphi}{$H+}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, fgl;6 Classes, SysUtils, Generics.Collections; 9 7 10 8 type … … 17 15 { TLanguages } 18 16 19 TLanguages = class(T FPGObjectList<TLanguage>)17 TLanguages = class(TObjectList<TLanguage>) 20 18 function SearchByCode(ACode: string): TLanguage; 21 19 procedure AddNew(Code: string; Name: string); -
trunk/Packages/Common/ULastOpenedList.pas
r131 r137 1 1 unit ULastOpenedList; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/Common/UListViewSort.pas
r131 r137 2 2 3 3 // Date: 2019-05-17 4 5 {$mode delphi}6 4 7 5 interface … … 9 7 uses 10 8 {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 11 Controls, DateUtils, Dialogs, fgl,Forms, Grids, StdCtrls, ExtCtrls,12 LclIntf, LclType, LResources ;9 Controls, DateUtils, Dialogs, Forms, Grids, StdCtrls, ExtCtrls, 10 LclIntf, LclType, LResources, Generics.Collections, Generics.Defaults; 13 11 14 12 type … … 19 17 TCompareEvent = function (Item1, Item2: TObject): Integer of object; 20 18 TListFilterEvent = procedure (ListViewSort: TListViewSort) of object; 19 20 TObjects = TObjectList<TObject>; 21 21 22 22 { TListViewSort } … … 52 52 {$ENDIF} 53 53 public 54 List: TFPGObjectList<TObject>;55 Source: TFPGObjectList<TObject>;54 Source: TObjects; 55 List: TObjects; 56 56 constructor Create(AOwner: TComponent); override; 57 57 destructor Destroy; override; … … 149 149 destructor TListViewEx.Destroy; 150 150 begin 151 inherited Destroy;151 inherited; 152 152 end; 153 153 … … 338 338 ListViewSortCompare: TCompareEvent; 339 339 340 function ListViewCompare(const Item1, Item2: TObject): Integer;340 function ListViewCompare(constref Item1, Item2: TObject): Integer; 341 341 begin 342 342 Result := ListViewSortCompare(Item1, Item2); … … 349 349 ListViewSortCompare := Compare; 350 350 if (List.Count > 0) then 351 List.Sort( ListViewCompare);351 List.Sort(TComparer<TObject>.Construct(ListViewCompare)); 352 352 end; 353 353 … … 355 355 begin 356 356 if Assigned(FOnFilter) then FOnFilter(Self) 357 else if Assigned(Source) then 358 List.Assign(Source) else 357 else if Assigned(Source) then begin 359 358 List.Clear; 359 List.AddRange(Source); 360 end else List.Clear; 360 361 if ListView.Items.Count <> List.Count then 361 362 ListView.Items.Count := List.Count; … … 412 413 begin 413 414 inherited; 414 List := T FPGObjectList<TObject>.Create;415 List. FreeObjects := False;415 List := TObjects.Create; 416 List.OwnsObjects := False; 416 417 end; 417 418 418 419 destructor TListViewSort.Destroy; 419 420 begin 420 List.Free;421 FreeAndNil(List); 421 422 inherited; 422 423 end; -
trunk/Packages/Common/UMemory.pas
r131 r137 1 1 unit UMemory; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 44 42 end; 45 43 44 46 45 implementation 47 46 … … 50 49 procedure TPositionMemory.SetSize(AValue: Integer); 51 50 begin 52 inherited SetSize(AValue);51 inherited; 53 52 if FPosition > FSize then FPosition := FSize; 54 53 end; … … 107 106 begin 108 107 Size := 0; 109 inherited Destroy;108 inherited; 110 109 end; 111 110 -
trunk/Packages/Common/UMetaCanvas.pas
r131 r137 1 1 unit UMetaCanvas; 2 2 3 {$mode delphi}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, Graphics, Types, fgl;6 Classes, SysUtils, Graphics, Types, Generics.Collections; 9 7 10 8 type … … 19 17 end; 20 18 21 TCanvasObjects = class(T FPGObjectList<TCanvasObject>)19 TCanvasObjects = class(TObjectList<TCanvasObject>) 22 20 end; 23 21 -
trunk/Packages/Common/UPersistentForm.pas
r131 r137 1 1 unit UPersistentForm; 2 3 {$mode delphi}4 2 5 3 // Date: 2020-11-26 -
trunk/Packages/Common/UPixelPointer.pas
r131 r137 59 59 function Color32ToColor(Color: TColor32): TColor; 60 60 function ColorToColor32(Color: TColor): TColor32; 61 61 62 62 63 implementation -
trunk/Packages/Common/UPool.pas
r131 r137 1 1 unit UPool; 2 2 3 {$mode Delphi}{$H+}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, syncobjs, fgl, UThreading;6 Classes, SysUtils, syncobjs, Generics.Collections, UThreading; 9 7 10 8 type … … 22 20 function NewItemObject: TObject; virtual; 23 21 public 24 Items: T FPGObjectList<TObject>;25 FreeItems: T FPGObjectList<TObject>;22 Items: TObjectList<TObject>; 23 FreeItems: TObjectList<TObject>; 26 24 function Acquire: TObject; virtual; 27 25 procedure Release(Item: TObject); virtual; … … 108 106 constructor TThreadedPool.Create; 109 107 begin 110 inherited Create;108 inherited; 111 109 Lock := TCriticalSection.Create; 112 110 end; … … 116 114 TotalCount := 0; 117 115 Lock.Free; 118 inherited Destroy;116 inherited; 119 117 end; 120 118 … … 185 183 begin 186 184 inherited; 187 Items := T FPGObjectList<TObject>.Create;188 FreeItems := T FPGObjectList<TObject>.Create;189 FreeItems. FreeObjects := False;185 Items := TObjectList<TObject>.Create; 186 FreeItems := TObjectList<TObject>.Create; 187 FreeItems.OwnsObjects := False; 190 188 FReleaseEvent := TEvent.Create(nil, False, False, ''); 191 189 end; -
trunk/Packages/Common/UPrefixMultiplier.pas
r131 r137 2 2 3 3 // Date: 2010-06-01 4 5 {$mode delphi}6 4 7 5 interface -
trunk/Packages/Common/URegistry.pas
r131 r137 1 1 unit URegistry; 2 3 {$MODE delphi}4 2 5 3 interface … … 48 46 HKEY_CURRENT_CONFIG, HKEY_DYN_DATA); 49 47 48 50 49 implementation 51 52 50 53 51 { TRegistryContext } -
trunk/Packages/Common/UResetableThread.pas
r122 r137 1 1 unit UResetableThread; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 167 165 FreeAndNil(FStopEvent); 168 166 FreeAndNil(FLock); 169 inherited Destroy;167 inherited; 170 168 end; 171 169 … … 286 284 constructor TThreadPool.Create; 287 285 begin 288 inherited Create;286 inherited; 289 287 end; 290 288 … … 293 291 TotalCount := 0; 294 292 WaitForEmpty; 295 inherited Destroy;293 inherited; 296 294 end; 297 295 -
trunk/Packages/Common/UScaleDPI.pas
r131 r137 3 3 { See: http://wiki.lazarus.freepascal.org/High_DPI } 4 4 5 {$mode delphi}{$H+}6 7 5 interface 8 6 9 7 uses 10 Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, fgl; 8 Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, 9 Generics.Collections; 11 10 12 11 type … … 28 27 end; 29 28 30 TControlDimensions = class(T FPGObjectList<TControlDimension>)29 TControlDimensions = class(TObjectList<TControlDimension>) 31 30 end; 32 31 -
trunk/Packages/Common/UStringTable.pas
r122 r137 1 1 unit UStringTable; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface -
trunk/Packages/Common/USyncCounter.pas
r122 r137 1 1 unit USyncCounter; 2 3 {$mode delphi}4 2 5 3 interface … … 25 23 procedure Assign(Source: TSyncCounter); 26 24 end; 25 27 26 28 27 implementation … … 69 68 begin 70 69 Lock.Free; 71 inherited Destroy;70 inherited; 72 71 end; 73 72 -
trunk/Packages/Common/UTheme.pas
r131 r137 5 5 uses 6 6 Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 Spin, Forms, fgl, Grids;7 Spin, Forms, Generics.Collections, Grids; 8 8 9 9 type … … 19 19 { TThemes } 20 20 21 TThemes = class(T FPGObjectList<TTheme>)21 TThemes = class(TObjectList<TTheme>) 22 22 function AddNew(Name: string): TTheme; 23 23 function FindByName(Name: string): TTheme; … … 48 48 49 49 procedure Register; 50 50 51 51 52 implementation -
trunk/Packages/Common/UThreading.pas
r131 r137 1 1 unit UThreading; 2 2 3 {$mode delphi}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, Forms, fgl, SyncObjs;6 Classes, SysUtils, Forms, Generics.Collections, SyncObjs; 9 7 10 8 type 11 9 TExceptionEvent = procedure (Sender: TObject; E: Exception) of object; 12 10 TMethodCall = procedure of object; 13 14 11 15 12 { TVirtualThread } … … 102 99 { TThreadList } 103 100 104 TThreadList = class(T FPGObjectList<TVirtualThread>)101 TThreadList = class(TObjectList<TVirtualThread>) 105 102 function FindById(Id: TThreadID): TVirtualThread; 106 103 constructor Create; virtual; … … 295 292 end; 296 293 FThread.Free; 297 inherited Destroy;294 inherited; 298 295 end; 299 296 … … 361 358 ThreadListLock := TCriticalSection.Create; 362 359 ThreadList := TThreadList.Create; 363 ThreadList. FreeObjects := False;360 ThreadList.OwnsObjects := False; 364 361 365 362 finalization -
trunk/Packages/Common/UTranslator.pas
r131 r137 1 1 unit UTranslator; 2 2 3 {$mode delphi}{$H+}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, Forms, ExtCtrls, Controls, fgl,LazFileUtils, LazUTF8,6 Classes, SysUtils, Forms, ExtCtrls, Controls, LazFileUtils, LazUTF8, 9 7 Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType, 10 LCLVersion ;8 LCLVersion, Generics.Collections; 11 9 12 10 type 13 11 THandleStringEvent = function (AValue: string): string of object; 14 12 15 TPoFiles = class(T FPGObjectList<TPOFile>)13 TPoFiles = class(TObjectList<TPOFile>) 16 14 end; 17 15 … … 27 25 { TComponentExcludesList } 28 26 29 TComponentExcludesList = class(T FPGObjectList<TComponentExcludes>)27 TComponentExcludesList = class(TObjectList<TComponentExcludes>) 30 28 function FindByClassType(AClassType: TClass): TComponentExcludes; 31 29 procedure DumpToStrings(Strings: TStrings); … … 290 288 Item := Component.ClassType; 291 289 while Assigned(Item) do begin 292 //ShowMessage(Component.Name + ', ' + Component.ClassName + ', ' + Item.ClassName + ', ' + PropertyName);293 290 Excludes := ComponentExcludes.FindByClassType(Item.ClassType); 294 291 if Assigned(Excludes) then begin -
trunk/Packages/Common/UURI.pas
r122 r137 2 2 3 3 // Date: 2011-04-04 4 5 {$mode delphi}6 4 7 5 interface … … 85 83 end; 86 84 85 87 86 implementation 88 87 … … 183 182 begin 184 183 Items.Free; 185 inherited Destroy;184 inherited; 186 185 end; 187 186 … … 232 231 begin 233 232 Path.Free; 234 inherited Destroy;233 inherited; 235 234 end; 236 235 … … 243 242 Fragment := TURI(Source).Fragment; 244 243 Query := TURI(Source).Query; 245 end else inherited Assign(Source);244 end else inherited; 246 245 end; 247 246 … … 291 290 destructor TURL.Destroy; 292 291 begin 293 inherited Destroy;292 inherited; 294 293 end; 295 294 … … 344 343 begin 345 344 Directory.Free; 346 inherited Destroy; 347 end; 348 345 inherited; 346 end; 349 347 350 348 end. -
trunk/Packages/Common/UXMLUtils.pas
r131 r137 1 1 unit UXMLUtils; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/CoolWeb/Common/UHtmlClasses.pas
r84 r137 1 1 unit UHtmlClasses; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 242 240 end; 243 241 242 244 243 implementation 245 244 246 245 resourcestring 247 246 SStringToIPConversionError = 'String to IP address conversion error'; 248 249 247 250 248 function LeftCutString(var Source, Output: string; Delimiter: string; Allowed: string = ''): Boolean; … … 322 320 begin 323 321 Value.Free; 324 inherited Destroy;322 inherited; 325 323 end; 326 324 … … 345 343 begin 346 344 Cells.Free; 347 inherited Destroy;345 inherited; 348 346 end; 349 347 … … 370 368 begin 371 369 Rows.Free; 372 inherited Destroy;370 inherited; 373 371 end; 374 372 … … 421 419 constructor THtmlInput.Create; 422 420 begin 423 424 421 end; 425 422 426 423 destructor THtmlInput.Destroy; 427 424 begin 428 inherited Destroy;425 inherited; 429 426 end; 430 427 … … 452 449 begin 453 450 Action.Free; 454 inherited Destroy;451 inherited; 455 452 end; 456 453 … … 754 751 begin 755 752 Levels.Free; 756 inherited Destroy;753 inherited; 757 754 end; 758 755 … … 893 890 begin 894 891 Data.Free; 895 inherited Destroy;892 inherited; 896 893 end; 897 894 -
trunk/Packages/CoolWeb/Common/UMIMEType.pas
r84 r137 1 1 unit UMIMEType; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 12 10 var 13 11 MIMETypeList: TStringList; 12 14 13 15 14 implementation -
trunk/Packages/CoolWeb/Common/UMemoryStreamEx.pas
r84 r137 1 1 unit UMemoryStreamEx; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 59 57 end; 60 58 59 61 60 implementation 62 61 … … 261 260 end; 262 261 263 procedure TMemoryStreamEx.WriteString(Data: string);262 procedure TMemoryStreamEx.WriteString(Data: string); 264 263 begin 265 264 if Length(Data) > 0 then … … 314 313 constructor TThreadMemoryStreamEx.Create; 315 314 begin 316 inherited Create;315 inherited; 317 316 Lock := TCriticalSection.Create; 318 317 end; … … 321 320 begin 322 321 Lock.Free; 323 inherited Destroy;322 inherited; 324 323 end; 325 324 -
trunk/Packages/CoolWeb/Common/UXmlClasses.pas
r84 r137 1 1 unit UXmlClasses; 2 3 {$mode delphi}{$H+}4 2 5 3 interface 6 4 7 uses Classes, SysUtils, StrUtils, SpecializedList,8 SpecializedDictionary;5 uses 6 Classes, SysUtils, StrUtils, SpecializedList, SpecializedDictionary; 9 7 10 8 type … … 50 48 property AsString: string read GetAsString; 51 49 end; 50 52 51 53 52 implementation -
trunk/Packages/CoolWeb/LazIDEReg.pas
r132 r137 1 1 unit LazIDEReg; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface … … 9 7 10 8 type 11 9 { TFileDescWebPage } 12 10 13 11 TFileDescWebPage = class(TFileDescPascalUnitWithResource) … … 27 25 function CreateStartFiles(AProject: TLazProject): TModalResult; override; 28 26 end; 29 30 27 31 28 resourcestring … … 158 155 end; 159 156 160 161 157 end. 162 158 -
trunk/Packages/CoolWeb/Modules/UPageList.pas
r84 r137 1 1 unit UPageList; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/CoolWeb/Modules/UWebUser.pas
r132 r137 1 1 unit UWebUser; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 48 46 end; 49 47 48 50 49 implementation 51 50 -
trunk/Packages/CoolWeb/Network/UTCPServer.pas
r114 r137 1 1 unit UTCPServer; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 68 66 write FOnClientConnect; 69 67 end; 68 70 69 71 70 implementation -
trunk/Packages/CoolWeb/Persistence/USqlDatabase.pas
r103 r137 1 1 unit USqlDatabase; 2 2 3 {$mode Delphi}{$H+} 4 5 // Modified: 2010-12-24 3 // Modified: 2022-09-08 6 4 7 5 interface 8 6 9 7 uses 10 SysUtils, Classes, Dialogs, mysql50, TypInfo, 11 Specialized Dictionary, SpecializedList;8 SysUtils, Classes, Dialogs, mysql50, TypInfo, SpecializedDictionary, 9 SpecializedList; 12 10 13 11 type … … 61 59 procedure CreateColumn(Table, ColumnName: string; ColumnType: TTypeKind); 62 60 procedure Query(DbRows: TDbRows; Data: string); 63 procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1'); 64 procedure Delete(ATable: string; Condition: string = '1'; 61 procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; 62 Condition: string = ''); 63 procedure Delete(ATable: string; Condition: string = ''; 65 64 Schema: string = ''); 66 65 procedure Insert(ATable: string; Data: TDictionaryStringString; 67 66 Schema: string = ''); 68 67 procedure Update(ATable: string; Data: TDictionaryStringString; 69 Condition: string = ' 1'; Schema: string = '');68 Condition: string = ''; Schema: string = ''); 70 69 procedure Replace(ATable: string; Data: TDictionaryStringString; 71 70 Schema: string = ''); … … 100 99 101 100 uses 102 DateUtils , Math;101 DateUtils; 103 102 104 103 resourcestring … … 184 183 Rows: TDbRows; 185 184 begin 186 // mySQLClient1.Connect;187 185 FSession := mysql_init(FSession); 188 // FSession.charset := 'latin2';189 186 NewSession := mysql_real_connect(FSession, PChar(HostName), PChar(UserName), 190 187 PChar(Password), PChar(Database), FPort, nil, CLIENT_LONG_PASSWORD + CLIENT_CONNECT_WITH_DB); … … 250 247 251 248 DbResult := mysql_store_result(FSession); 252 if Assigned(DbResult) then begin 253 DbRows.Count := mysql_num_rows(DbResult); 254 for I := 0 to DbRows.Count - 1 do begin 255 DbRow := mysql_fetch_row(DbResult); 256 DbRows[I] := TDictionaryStringString.Create; 257 with DbRows[I] do begin 258 for II := 0 to mysql_num_fields(DbResult) - 1 do begin 259 Add(mysql_fetch_field_direct(DbResult, II)^.Name, 260 PChar((DbRow + II)^)); 249 try 250 if Assigned(DbResult) then begin 251 DbRows.Count := mysql_num_rows(DbResult); 252 for I := 0 to DbRows.Count - 1 do begin 253 DbRow := mysql_fetch_row(DbResult); 254 DbRows[I] := TDictionaryStringString.Create; 255 with DbRows[I] do begin 256 for II := 0 to mysql_num_fields(DbResult) - 1 do begin 257 Add(mysql_fetch_field_direct(DbResult, II)^.Name, 258 PChar((DbRow + II)^)); 261 259 end; 262 260 end; 263 261 end; 264 end; 265 mysql_free_result(DbResult); 262 end; 263 finally 264 mysql_free_result(DbResult); 265 end; 266 266 end; 267 267 … … 296 296 end; 297 297 298 procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1'); 298 procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = ''); 299 var 300 QueryText: string; 299 301 begin 300 302 LastUsedTable := ATable; 301 Query(DbRows, 'SELECT ' + Filter + ' FROM `' + ATable + '` WHERE ' + Condition); 303 QueryText := 'SELECT ' + Filter + ' FROM `' + ATable + '`'; 304 if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition; 305 Query(DbRows, QueryText); 302 306 end; 303 307 304 308 procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString; 305 Condition: string = '1'; Schema: string = ''); 306 var 309 Condition: string = ''; Schema: string = ''); 310 var 311 QueryText: string; 307 312 DbValues: string; 308 313 Value: string; … … 322 327 DbResult := TDbRows.Create; 323 328 if Schema <> '' then Schema := '`' + Schema + '`.'; 324 Query(DbResult, 'UPDATE ' + Schema + '`' + ATable + '` SET ' + DbValues + ' WHERE ' + Condition); 329 QueryText := 'UPDATE ' + Schema + '`' + ATable + '` SET ' + DbValues; 330 if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition; 331 Query(DbResult, QueryText); 325 332 finally 326 333 DbResult.Free; … … 333 340 end; 334 341 335 procedure TSqlDatabase.Delete(ATable: string; Condition: string = ' 1';342 procedure TSqlDatabase.Delete(ATable: string; Condition: string = ''; 336 343 Schema: string = ''); 337 344 var 345 QueryText: string; 338 346 DbResult: TDbRows; 339 347 begin … … 342 350 DbResult := TDbRows.Create; 343 351 if Schema <> '' then Schema := '`' + Schema + '`.'; 344 Query(DbResult, 'DELETE FROM ' + Schema + '`' + ATable + '` WHERE ' + Condition); 352 QueryText := 'DELETE FROM ' + Schema + '`' + ATable + '`'; 353 if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition; 354 Query(DbResult, QueryText); 345 355 finally 346 356 DbResult.Free; … … 497 507 end. 498 508 499 -
trunk/Packages/CoolWeb/WebServer/UHTTPServer.pas
r130 r137 1 1 unit UHTTPServer; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 419 417 procedure THTTPSessionStorage.Load(HandlerData: THTTPHandlerData); 420 418 begin 421 422 419 end; 423 420 424 421 procedure THTTPSessionStorage.Save(HandlerData: THTTPHandlerData); 425 422 begin 426 427 423 end; 428 424 -
trunk/Packages/CoolWeb/WebServer/UHTTPServerCGI.pas
r100 r137 1 1 unit UHTTPServerCGI; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 21 19 end; 22 20 21 procedure Register; 23 22 24 procedure Register;25 23 26 24 implementation … … 33 31 RegisterComponents('CoolWeb', [THTTPServerCGI]); 34 32 end; 35 36 33 37 34 { THTTPServerCGI } … … 46 43 begin 47 44 EnvVars.Free; 48 inherited Destroy;45 inherited; 49 46 end; 50 47 -
trunk/Packages/CoolWeb/WebServer/UHTTPServerTCP.pas
r130 r137 1 1 unit UHTTPServerTCP; 2 3 {$mode delphi}4 2 5 3 interface … … 141 139 end; 142 140 143 144 141 { THTTPServerTCP } 145 142 -
trunk/Packages/CoolWeb/WebServer/UHTTPServerTurboPower.pas
r84 r137 1 1 unit UHTTPServerTurboPower; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 32 30 end; 33 31 34 35 32 { THTTPServerTurboPower } 36 33 … … 62 59 destructor THTTPServerTurboPower.Destroy; 63 60 begin 64 inherited Destroy;61 inherited; 65 62 end; 66 63 -
trunk/Packages/CoolWeb/WebServer/UHTTPSessionFile.pas
r114 r137 1 1 unit UHTTPSessionFile; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 36 34 procedure Register; 37 35 36 38 37 implementation 39 38 … … 45 44 RegisterComponents('CoolWeb', [THTTPSessionStorageFile]); 46 45 end; 47 48 46 49 47 { THTTPSession } … … 119 117 Sessions.Destroy; 120 118 Lock.Destroy; 121 inherited Destroy;119 inherited; 122 120 end; 123 121 -
trunk/Packages/CoolWeb/WebServer/UHTTPSessionMySQL.pas
r100 r137 1 1 unit UHTTPSessionMySQL; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 37 35 procedure Register; 38 36 37 39 38 implementation 40 39 … … 43 42 RegisterComponents('CoolWeb', [THTTPSessionStorageMySQL]); 44 43 end; 45 46 44 47 45 { THTTPSession } … … 138 136 Sessions.Free; 139 137 Lock.Free; 140 inherited Destroy;138 inherited; 141 139 end; 142 140 -
trunk/Packages/CoolWeb/WebServer/UTurboPowerForm.pas
r84 r137 1 1 unit UTurboPowerForm; 2 3 {$mode delphi}4 2 5 3 interface … … 35 33 FormWebBrowser: TFormWebBrowser; 36 34 35 37 36 implementation 38 37 … … 51 50 end; 52 51 53 initialization54 55 52 end. 56 53 -
trunk/Packages/CoolWeb/WebServer/UWebApp.pas
r132 r137 1 1 unit UWebApp; 2 2 3 {$mode Delphi}{$H+}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, UWebPage, UHTTPSessionFile, 9 UHTTPServer, Forms, FileUtil, fgl;6 Classes, SysUtils, UWebPage, UHTTPSessionFile, UHTTPServer, Forms, FileUtil, 7 Generics.Collections; 10 8 11 9 type … … 22 20 { TPageList } 23 21 24 TPageList = class(T FPGObjectList<TRegistredPage>)22 TPageList = class(TObjectList<TRegistredPage>) 25 23 RootDir: string; 26 24 function FindByPage(Page: TWebPage): TRegistredPage; … … 221 219 end; 222 220 223 224 initialization225 226 finalization227 228 221 end. 229 222 -
trunk/Packages/CoolWeb/WebServer/UWebPage.pas
r84 r137 1 1 unit UWebPage; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface … … 11 9 TOnProduceEvent = procedure(HandlerData: THTTPHandlerData) of object; 12 10 13 14 11 { TWebPage } 15 12 … … 18 15 FCaption: string; 19 16 FOnProduce: TOnProduceEvent; 17 FRaw: Boolean; 20 18 published 19 property Raw: Boolean read FRaw write FRaw; 21 20 property Caption: string read FCaption write FCaption; 22 21 property OnProduce: TOnProduceEvent read FOnProduce write FOnProduce; 23 22 end; 24 25 23 26 24 TWebPageClass = class of TWebPage; -
trunk/Packages/ModularSystem/Demo/UMainForm.pas
r105 r137 1 1 unit UMainForm; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface -
trunk/Packages/ModularSystem/Demo/UModuleACL.pas
r105 r137 1 1 unit UModuleACL; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface … … 33 31 destructor TModuleACL.Destroy; 34 32 begin 35 inherited Destroy;33 inherited; 36 34 end; 37 35 -
trunk/Packages/ModularSystem/Demo/UModuleBase.pas
r105 r137 1 1 unit UModuleBase; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface … … 30 28 destructor TModuleBase.Destroy; 31 29 begin 32 inherited Destroy;30 inherited; 33 31 end; 34 32 -
trunk/Packages/ModularSystem/Demo/UModuleUser.pas
r105 r137 1 1 unit UModuleUser; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface … … 16 14 destructor Destroy; override; 17 15 end; 16 18 17 19 18 implementation … … 33 32 destructor TModuleUser.Destroy; 34 33 begin 35 inherited Destroy;34 inherited; 36 35 end; 37 36 -
trunk/Packages/ModularSystem/ModularSystem.lpk
r132 r137 14 14 <Parsing> 15 15 <SyntaxOptions> 16 <SyntaxMode Value="Delphi"/> 16 17 <CStyleOperator Value="False"/> 17 18 <AllowLabel Value="False"/> -
trunk/Packages/ModularSystem/UModularSystem.pas
r132 r137 1 1 unit UModularSystem; 2 2 3 {$mode Delphi}{$H+}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, fgl, URegistry;6 Classes, SysUtils, Generics.Collections, URegistry; 9 7 10 8 type … … 65 63 end; 66 64 67 TModules = class(T FPGObjectList<TModule>)65 TModules = class(TObjectList<TModule>) 68 66 end; 69 67 -
trunk/Packages/PersistentData/Backend/UPDClientINI.pas
r87 r137 1 1 unit UPDClientINI; 2 3 {$mode delphi}4 2 5 3 interface … … 23 21 procedure Disconnect; override; 24 22 end; 23 25 24 26 25 implementation … … 49 48 begin 50 49 Disconnect; 51 inherited Destroy;50 inherited; 52 51 end; 53 52 -
trunk/Packages/PersistentData/Backend/UPDClientMemory.pas
r113 r137 1 1 unit UPDClientMemory; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface … … 40 38 resourcestring 41 39 SObjectNotFound = 'Object with id %s not found'; 40 42 41 43 42 implementation … … 147 146 procedure TPDClientMemory.ListSave(AList: TListProxy); 148 147 begin 149 150 148 end; 151 149 152 150 procedure TPDClientMemory.TypeDefine(AType: TPDType); 153 151 begin 154 155 152 end; 156 153 157 154 procedure TPDClientMemory.TypeUndefine(AType: TPDType); 158 155 begin 159 160 156 end; 161 157 … … 167 163 procedure TPDClientMemory.Install; 168 164 begin 169 170 165 end; 171 166 172 167 procedure TPDClientMemory.Uninstall; 173 168 begin 174 175 169 end; 176 170 … … 185 179 begin 186 180 Objects.Free; 187 inherited Destroy;181 inherited; 188 182 end; 189 183 -
trunk/Packages/PersistentData/Backend/UPDClientMySQL.pas
r113 r137 1 1 unit UPDClientMySQL; 2 3 {$mode delphi}4 2 5 3 interface … … 46 44 end; 47 45 46 48 47 implementation 49 50 48 51 49 resourcestring 52 50 SMissingBaseType = 'Missing base typ for %s'; 53 51 SUndefinedType = 'Undefined type in %0:s.%1:s'; 54 55 52 56 53 { TPDClientMySQL } … … 262 259 begin 263 260 FreeAndNil(FDatabase); 264 inherited Destroy;261 inherited; 265 262 end; 266 263 -
trunk/Packages/PersistentData/Backend/UPDClientRegistry.pas
r87 r137 1 1 unit UPDClientRegistry; 2 3 {$mode delphi}4 2 5 3 interface … … 13 11 14 12 TPDClientRegistry = class(TPDClient) 13 public 15 14 Reg: TRegistry; 16 15 //procedure GetItemList(Condition: TCondition; ItemList: TItemList); override; … … 19 18 destructor Destroy; override; 20 19 end; 20 21 21 22 22 implementation … … 46 46 begin 47 47 Reg.Free; 48 inherited Destroy;48 inherited; 49 49 end; 50 50 -
trunk/Packages/PersistentData/Backend/UPDClientXMLRPC.pas
r87 r137 1 1 unit UPDClientXMLRPC; 2 3 {$mode delphi}4 2 5 3 interface … … 16 14 end; 17 15 16 18 17 implementation 19 20 18 21 19 { TPDClientXMLRPC } -
trunk/Packages/PersistentData/Demo/UFormMain.pas
r87 r137 1 1 unit UFormMain; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 30 28 var 31 29 FormMain: TFormMain; 30 32 31 33 32 implementation -
trunk/Packages/PersistentData/UPDClient.pas
r113 r137 1 1 unit UPDClient; 2 3 {$mode delphi}4 2 5 3 interface … … 226 224 begin 227 225 Properties.Free; 228 inherited Destroy;226 inherited; 229 227 end; 230 228 … … 257 255 begin 258 256 Properties.Free; 259 inherited Destroy;257 inherited; 260 258 end; 261 259 … … 289 287 Objects.Free; 290 288 ColumnsFilter.Free; 291 inherited Destroy;289 inherited; 292 290 end; 293 291 … … 423 421 begin 424 422 Types.Free; 425 inherited Destroy;423 inherited; 426 424 end; 427 425 -
trunk/Packages/PersistentData/UPDServer.pas
r87 r137 1 1 unit UPDServer; 2 3 {$mode delphi}4 2 5 3 interface … … 10 8 type 11 9 TPDServer = class 10 end; 12 11 13 end;14 12 15 13 implementation -
trunk/Packages/PersistentData/UPersistentData.pas
r113 r137 1 1 unit UPersistentData; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 84 82 begin 85 83 FreeAndNil(Items); 86 inherited Destroy;84 inherited; 87 85 end; 88 86 -
trunk/Packages/TemplateGenerics/Additional/UBinarySerializer.pas
r90 r137 1 1 unit UBinarySerializer; 2 3 {$mode delphi}{$H+}4 2 5 3 interface … … 213 211 begin 214 212 if OwnsList then FList.Free; 215 inherited Destroy;213 inherited; 216 214 end; 217 215 -
trunk/Packages/TemplateGenerics/Demo/UMainForm.pas
r90 r137 1 1 unit UMainForm; 2 3 {$mode delphi}{$H+}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Generic/GenericListString.inc
r90 r137 89 89 begin 90 90 Clear; 91 inherited Destroy;91 inherited; 92 92 end; 93 93 -
trunk/Packages/TemplateGenerics/Generic/GenericQueue.inc
r90 r137 81 81 begin 82 82 FList.Free; 83 inherited Destroy;83 inherited; 84 84 end; 85 85 -
trunk/Packages/TemplateGenerics/Generic/GenericSet.inc
r84 r137 60 60 begin 61 61 FList.Free; 62 inherited Destroy;62 inherited; 63 63 end; 64 64 -
trunk/Packages/TemplateGenerics/Generic/GenericStack.inc
r84 r137 66 66 begin 67 67 FList.Free; 68 inherited Destroy;68 inherited; 69 69 end; 70 70 -
trunk/Packages/TemplateGenerics/Specialized/SpecializedBitmap.pas
r84 r137 1 1 unit SpecializedBitmap; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedDictionary.pas
r84 r137 1 1 unit SpecializedDictionary; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedList.pas
r90 r137 1 1 unit SpecializedList; 2 2 3 interface 4 3 5 {$mode delphi} 4 5 interface6 6 7 7 uses -
trunk/Packages/TemplateGenerics/Specialized/SpecializedMatrix.pas
r84 r137 1 1 unit SpecializedMatrix; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedPoint.pas
r90 r137 1 1 unit SpecializedPoint; 2 3 {$mode objfpc}{$H+}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedQueue.pas
r84 r137 1 1 unit SpecializedQueue; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedRectangle.pas
r90 r137 1 1 unit SpecializedRectangle; 2 3 {$mode Delphi}{$H+}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedSet.pas
r84 r137 1 1 unit SpecializedSet; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedStack.pas
r84 r137 1 1 unit SpecializedStack; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Packages/TemplateGenerics/Specialized/SpecializedStream.pas
r90 r137 1 1 unit SpecializedStream; 2 3 {$mode delphi}4 2 5 3 interface … … 200 198 begin 201 199 if OwnsList then FList.Free; 202 inherited Destroy;200 inherited; 203 201 end; 204 202 -
trunk/Packages/TemplateGenerics/Specialized/SpecializedTree.pas
r84 r137 1 1 unit SpecializedTree; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Pages/UPageAdmin.pas
r105 r137 1 1 unit UPageAdmin; 2 3 {$mode delphi}4 2 5 3 interface -
trunk/Pages/UServerInfoPage.pas
r105 r137 1 1 unit UServerInfoPage; 2 3 {$mode delphi}4 2 5 3 interface … … 14 12 TServerInfoPage = class(TWebPage) 15 13 procedure DataModuleProduce(HandlerData: THTTPHandlerData); 16 private17 { private declarations }18 14 public 19 15 ModuleUser: TModuleUser; … … 22 18 var 23 19 ServerInfoPage: TServerInfoPage; 20 24 21 25 22 implementation -
trunk/UCore.pas
r132 r137 1 1 unit UCore; 2 3 {$mode delphi}4 2 5 3 interface … … 55 53 56 54 implementation 57 58 55 59 56 { TCore } … … 191 188 end; 192 189 190 initialization 193 191 194 initialization 195 {$I UCore.lrs} 192 {$I UCore.lrs} 196 193 197 194 end. -
trunk/ZdechovNET.lpi
r132 r137 122 122 </Item7> 123 123 </RequiredPackages> 124 <Units Count=" 39">124 <Units Count="40"> 125 125 <Unit0> 126 126 <Filename Value="ZdechovNET.lpr"/> … … 188 188 <Filename Value="Modules/ZdechovNET/UContactPage.pas"/> 189 189 <IsPartOfProject Value="True"/> 190 <HasResources Value="True"/> 190 <ComponentName Value="ContactPage"/> 191 <HasResources Value="True"/> 192 <ResourceBaseClass Value="DataModule"/> 191 193 </Unit12> 192 194 <Unit13> … … 334 336 <ResourceBaseClass Value="DataModule"/> 335 337 </Unit38> 338 <Unit39> 339 <Filename Value="Modules/ZdechovNET/URobotsPage.pas"/> 340 <IsPartOfProject Value="True"/> 341 <ComponentName Value="RobotsPage"/> 342 <HasResources Value="True"/> 343 <ResourceBaseClass Value="DataModule"/> 344 </Unit39> 336 345 </Units> 337 346 </ProjectOptions>
Note:
See TracChangeset
for help on using the changeset viewer.