| 1 | unit ModulePortal;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Classes, SysUtils, ModularSystem, SqlDatabase, Utils, WebSession, User,
|
|---|
| 7 | WebPage, HtmlClasses, ModuleBase, ModuleUser, ModuleNews, Generics;
|
|---|
| 8 |
|
|---|
| 9 | type
|
|---|
| 10 |
|
|---|
| 11 | { TModulePortal }
|
|---|
| 12 |
|
|---|
| 13 | TModulePortal = class(TModule)
|
|---|
| 14 | private
|
|---|
| 15 | Time: TDateTime;
|
|---|
| 16 | WebPagePortal: TWebPage;
|
|---|
| 17 | function ShowFooter(Session: TWebSession): string;
|
|---|
| 18 | function ShowHeader(Session: TWebSession): string;
|
|---|
| 19 | procedure GeneratePage(ASession: TWebSession; Page: TWebPage);
|
|---|
| 20 | public
|
|---|
| 21 | ModuleBase: TModuleBase;
|
|---|
| 22 | ModuleUser: TModuleUser;
|
|---|
| 23 | constructor Create(Owner: TComponent); override;
|
|---|
| 24 | destructor Destroy; override;
|
|---|
| 25 | procedure Start; override;
|
|---|
| 26 | procedure Stop; override;
|
|---|
| 27 | procedure Install; override;
|
|---|
| 28 | procedure Uninstall; override;
|
|---|
| 29 | procedure Upgrade; override;
|
|---|
| 30 | end;
|
|---|
| 31 |
|
|---|
| 32 |
|
|---|
| 33 | implementation
|
|---|
| 34 |
|
|---|
| 35 | uses
|
|---|
| 36 | Core, PagePortal;
|
|---|
| 37 |
|
|---|
| 38 | { TModulePortal }
|
|---|
| 39 |
|
|---|
| 40 | constructor TModulePortal.Create(Owner: TComponent);
|
|---|
| 41 | begin
|
|---|
| 42 | inherited;
|
|---|
| 43 | Identification := 'Portal';
|
|---|
| 44 | Title := 'Intranet user portal';
|
|---|
| 45 | Version := '1.0';
|
|---|
| 46 | License := 'GNU/LGPL v3';
|
|---|
| 47 | Author := 'Chronosoft';
|
|---|
| 48 | Dependencies.Add('User');
|
|---|
| 49 | Dependencies.Add('Finance');
|
|---|
| 50 | Dependencies.Add('News');
|
|---|
| 51 | end;
|
|---|
| 52 |
|
|---|
| 53 | destructor TModulePortal.Destroy;
|
|---|
| 54 | begin
|
|---|
| 55 | inherited;
|
|---|
| 56 | end;
|
|---|
| 57 |
|
|---|
| 58 | procedure TModulePortal.Start;
|
|---|
| 59 | begin
|
|---|
| 60 | BeforeStart;
|
|---|
| 61 | ModuleBase := TModuleBase(Manager.FindModuleByName('Base'));
|
|---|
| 62 | ModuleBase.OnGeneratePage := GeneratePage;
|
|---|
| 63 | WebPagePortal := TWebPagePortal.Create(nil);
|
|---|
| 64 | ModuleBase.Pages.RegisterPage(WebPagePortal, '');
|
|---|
| 65 | ModuleUser := TModuleUser(Manager.FindModuleByName('User'));
|
|---|
| 66 | TWebPagePortal(WebPagePortal).ModuleUser := ModuleUser;
|
|---|
| 67 | TWebPagePortal(WebPagePortal).ModuleNews := TModuleNews(Manager.FindModuleByName('News'));
|
|---|
| 68 | AfterStart;
|
|---|
| 69 | end;
|
|---|
| 70 |
|
|---|
| 71 | procedure TModulePortal.Stop;
|
|---|
| 72 | begin
|
|---|
| 73 | BeforeStop;
|
|---|
| 74 | ModuleBase.Pages.UnregisterPage(WebPagePortal);
|
|---|
| 75 | FreeAndNil(WebPagePortal);
|
|---|
| 76 | ModuleBase := nil;
|
|---|
| 77 | ModuleUser := nil;
|
|---|
| 78 | AfterStop;
|
|---|
| 79 | end;
|
|---|
| 80 |
|
|---|
| 81 | procedure TModulePortal.Install;
|
|---|
| 82 | var
|
|---|
| 83 | DbRows: TDbRows;
|
|---|
| 84 | begin
|
|---|
| 85 | try
|
|---|
| 86 | DbRows := TDbRows.Create;
|
|---|
| 87 |
|
|---|
| 88 | Core.Core.CommonDatabase.Query(DbRows,
|
|---|
| 89 | 'CREATE TABLE IF NOT EXISTS `Panel` (' +
|
|---|
| 90 | ' `Id` int(11) NOT NULL AUTO_INCREMENT,' +
|
|---|
| 91 | ' `Module` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 92 | ' `Parameters` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 93 | ' `Order` int(11) NOT NULL,' +
|
|---|
| 94 | ' `PanelColumn` int(11) NOT NULL,' +
|
|---|
| 95 | ' PRIMARY KEY (`Id`),' +
|
|---|
| 96 | ' KEY `PanelColumn` (`PanelColumn`)' +
|
|---|
| 97 | ') ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
|
|---|
| 98 |
|
|---|
| 99 | Core.Core.CommonDatabase.Query(DbRows,
|
|---|
| 100 | 'CREATE TABLE IF NOT EXISTS `PanelColumn` (' +
|
|---|
| 101 | ' `Id` int(11) NOT NULL AUTO_INCREMENT,' +
|
|---|
| 102 | ' `Width` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 103 | ' PRIMARY KEY (`Id`)' +
|
|---|
| 104 | ') ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
|
|---|
| 105 |
|
|---|
| 106 | Core.Core.CommonDatabase.Query(DbRows,
|
|---|
| 107 | 'ALTER TABLE `Panel`' +
|
|---|
| 108 | ' ADD CONSTRAINT `Panel_ibfk_1` FOREIGN KEY (`PanelColumn`) REFERENCES `panelcolumn` (`Id`);');
|
|---|
| 109 |
|
|---|
| 110 | Core.Core.CommonDatabase.Query(DbRows,
|
|---|
| 111 | 'CREATE TABLE IF NOT EXISTS `HyperlinkGroup` (' +
|
|---|
| 112 | ' `Id` int(11) NOT NULL AUTO_INCREMENT,' +
|
|---|
| 113 | ' `Name` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 114 | ' PRIMARY KEY (`Id`)' +
|
|---|
| 115 | ') ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
|
|---|
| 116 |
|
|---|
| 117 | Core.Core.CommonDatabase.Query(DbRows,
|
|---|
| 118 | 'CREATE TABLE IF NOT EXISTS `Hyperlink` (' +
|
|---|
| 119 | ' `Id` int(11) NOT NULL AUTO_INCREMENT,' +
|
|---|
| 120 | ' `Name` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 121 | ' `URL` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 122 | ' `Group` int(11) NOT NULL,' +
|
|---|
| 123 | ' `IconFile` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 124 | ' `PermissionModule` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 125 | ' `PermissionOperation` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
|
|---|
| 126 | ' `Enable` int(11) NOT NULL DEFAULT "1",' +
|
|---|
| 127 | ' PRIMARY KEY (`Id`),' +
|
|---|
| 128 | ' KEY `Group` (`Group`),' +
|
|---|
| 129 | ' KEY `Enable` (`Enable`)' +
|
|---|
| 130 | ') ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
|
|---|
| 131 |
|
|---|
| 132 | Core.Core.CommonDatabase.Query(DbRows,
|
|---|
| 133 | 'ALTER TABLE `Hyperlink`' +
|
|---|
| 134 | ' ADD CONSTRAINT `Hyperlink_ibfk_1` FOREIGN KEY (`Group`) REFERENCES `hyperlinkgroup` (`Id`);');
|
|---|
| 135 |
|
|---|
| 136 | finally
|
|---|
| 137 | DbRows.Free;
|
|---|
| 138 | end;
|
|---|
| 139 | inherited;
|
|---|
| 140 | end;
|
|---|
| 141 |
|
|---|
| 142 | procedure TModulePortal.Uninstall;
|
|---|
| 143 | var
|
|---|
| 144 | DbRows: TDbRows;
|
|---|
| 145 | begin
|
|---|
| 146 | inherited Uninstall;
|
|---|
| 147 | try
|
|---|
| 148 | DbRows := TDbRows.Create;
|
|---|
| 149 | Core.Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `Panel`');
|
|---|
| 150 | Core.Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `PanelColumn`');
|
|---|
| 151 | Core.Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `Hyperlink`');
|
|---|
| 152 | Core.Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `HyperlinkGroup`');
|
|---|
| 153 | finally
|
|---|
| 154 | DbRows.Free;
|
|---|
| 155 | end;
|
|---|
| 156 | end;
|
|---|
| 157 |
|
|---|
| 158 | procedure TModulePortal.Upgrade;
|
|---|
| 159 | begin
|
|---|
| 160 | inherited;
|
|---|
| 161 | end;
|
|---|
| 162 |
|
|---|
| 163 | function TModulePortal.ShowHeader(Session: TWebSession): string;
|
|---|
| 164 | var
|
|---|
| 165 | ScriptName: string;
|
|---|
| 166 | PathTreePath: string;
|
|---|
| 167 | Navigation: string;
|
|---|
| 168 | ScriptNameParts: TListString;
|
|---|
| 169 | ScriptNamePart: string;
|
|---|
| 170 | I: Integer;
|
|---|
| 171 | BodyParam: string;
|
|---|
| 172 | Path: string;
|
|---|
| 173 | Output: string;
|
|---|
| 174 | begin
|
|---|
| 175 | try
|
|---|
| 176 | ScriptNameParts := TListString.Create;
|
|---|
| 177 | Navigation := '';
|
|---|
| 178 | Path := '';
|
|---|
| 179 | ScriptName := '';
|
|---|
| 180 |
|
|---|
| 181 | //ScriptName := $_SERVER['SCRIPT_NAME'];
|
|---|
| 182 | while Pos('//', ScriptName) > 0 do
|
|---|
| 183 | ScriptName := StringReplace('//', '/', ScriptName, [rfReplaceAll]);
|
|---|
| 184 | PathTreePath := '/';
|
|---|
| 185 | //PathTreeItem := PathTree;
|
|---|
| 186 | //Navigation := '<a href="' + NavigationLink(PathTreePath) + '">' + PathTreeItem[0] + '</a> > ';
|
|---|
| 187 | ScriptName := Copy(ScriptName, Length(Core.Core.BaseURL), Length(ScriptName));
|
|---|
| 188 | ScriptNameParts.Explode('/', ScriptName);
|
|---|
| 189 | ScriptNameParts.Delete(0);
|
|---|
| 190 | (*
|
|---|
| 191 | for I := 0 to ScriptNameParts.Count - 1 do begin
|
|---|
| 192 | ScriptNamePart := ScriptNameParts[I];
|
|---|
| 193 | //echo($ScriptNamePart.'<br />');
|
|---|
| 194 | if array_key_exists($ScriptNamePart, $PathTreeItem) then begin
|
|---|
| 195 | if is_array($PathTreeItem[$ScriptNamePart]) then begin
|
|---|
| 196 |
|
|---|
| 197 | PathTreeItem = $PathTreeItem[$ScriptNamePart];
|
|---|
| 198 | PathTreePath .= $ScriptNamePart.'/';
|
|---|
| 199 | if PathTreeItem[0] != '' then
|
|---|
| 200 | Navigation := Navigation + '<a href="' + $this->System->Config['Web']['RootFolder'] + PathTreePath + '">' + PathTreeItem[0] + '</a> > ';
|
|---|
| 201 | end else begin
|
|---|
| 202 | if(PathTreeItem[ScriptNamePart] != '')
|
|---|
| 203 | Navigation := Navigation + '<a href="' + $this->System->Config['Web']['RootFolder'].$PathTreePath.$ScriptNamePart.'">'.$PathTreeItem[$ScriptNamePart].'</a> > ';
|
|---|
| 204 | end;
|
|---|
| 205 | end;
|
|---|
| 206 | end; *)
|
|---|
| 207 | Navigation := Copy(Navigation, 1, Length(Navigation) - 6);
|
|---|
| 208 |
|
|---|
| 209 | BodyParam := '';
|
|---|
| 210 | //if(isset($this->Load)) BodyParam := BodyParam + ' onload="'.$this->Load.'"';
|
|---|
| 211 | //if(isset($this->Unload)) BodyParam := BodyParam + ' onunload="'.$this->Unload.'"';
|
|---|
| 212 | Output := '<?xml version="1.0" encoding="' + Core.Core.Charset + '"?>' + LineEnding +
|
|---|
| 213 | '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' +
|
|---|
| 214 | '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="cs" lang="cs">' +
|
|---|
| 215 | '<head><link rel="stylesheet" href="' + NavigationLink('/style/' + Core.Core.Style + '/style.css') + '" type="text/css" media="all" />' +
|
|---|
| 216 | '<meta http-equiv="content-type" content="application/xhtml+xml; charset=' + Core.Core.Charset + '" />' +
|
|---|
| 217 | '<script type="text/javascript" src="' + Core.Core.BaseURL + '/style/' + Core.Core.Style + '/global.js"></script>' +
|
|---|
| 218 | '<title>' + Session.GlobalTitle + ' - ' + Path + '</title>' +
|
|---|
| 219 | '</head><body' + BodyParam + '>' +
|
|---|
| 220 | '<div id="Title">' + Title + '</div>' +
|
|---|
| 221 | '<div class="Navigation"><span class="MenuItem"><strong>Navigace :: </strong> ';
|
|---|
| 222 | Output := Output + Navigation + '</span><div class="MenuItem2">';
|
|---|
| 223 | if Assigned(ModuleUser) then begin
|
|---|
| 224 | if ModuleUser.User.Id = UnknownUser then
|
|---|
| 225 | Output := Output + '<a href="' + MakeLink('Přihlášení',
|
|---|
| 226 | NavigationLink('/?Action=LoginForm')) + ' ' +
|
|---|
| 227 | MakeLink('Registrace', NavigationLink('/?Action=UserRegister'))
|
|---|
| 228 | else Output := Output + ModuleUser.User.Name + ' ' + MakeLink('Odhlásit',
|
|---|
| 229 | NavigationLink('/?Action=Logout'));
|
|---|
| 230 | end;
|
|---|
| 231 | // <a href="'.$this->System->Config['Web']['RootFolder'].'/?Action=UserOptions">Nastavení</a>';
|
|---|
| 232 | Output := Output + '</div></div>';
|
|---|
| 233 | Result := Output;
|
|---|
| 234 | finally
|
|---|
| 235 | ScriptNameParts.Free;
|
|---|
| 236 | end;
|
|---|
| 237 | end;
|
|---|
| 238 |
|
|---|
| 239 | procedure TModulePortal.GeneratePage(ASession: TWebSession; Page: TWebPage);
|
|---|
| 240 | var
|
|---|
| 241 | I: Integer;
|
|---|
| 242 | TitleTag: THtmlString;
|
|---|
| 243 | begin
|
|---|
| 244 | with ASession do begin
|
|---|
| 245 | HtmlDocument.ContentLanguage := 'cs';
|
|---|
| 246 | GlobalTitle := 'Portál';
|
|---|
| 247 | HtmlDocument.Styles.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Style.css'));
|
|---|
| 248 | HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Global.js'));
|
|---|
| 249 | HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/jquery.js'));
|
|---|
| 250 |
|
|---|
| 251 | TitleTag := THtmlString.Create;
|
|---|
| 252 | //TitleTag.Text := ShowHeader(ASession);
|
|---|
| 253 | HtmlDocument.Body.SubItems.Insert(0, TitleTag);
|
|---|
| 254 | TitleTag := THtmlString.Create;
|
|---|
| 255 | TitleTag.Text := ShowFooter(ASession);
|
|---|
| 256 | HtmlDocument.Body.SubItems.Insert(0, TitleTag);
|
|---|
| 257 | //Page.Page.OnProduce(HandlerData);
|
|---|
| 258 | HtmlDocument.Title := Page.Caption;
|
|---|
| 259 | TitleTag.Text := '<div class="TitlePanel"><span class="GlobalTitle">' + GlobalTitle +
|
|---|
| 260 | '</span> - ' + HtmlDocument.Title + '</div>';
|
|---|
| 261 | HtmlDocument.Title := GlobalTitle + ' - ' + HtmlDocument.Title;
|
|---|
| 262 | with HtmlDocument.AsXmlDocument do
|
|---|
| 263 | try
|
|---|
| 264 | Formated := TCore(MainModule).FormatHTML;
|
|---|
| 265 | Response.Content.WriteString(AsString);
|
|---|
| 266 | finally
|
|---|
| 267 | Free;
|
|---|
| 268 | end;
|
|---|
| 269 | end;
|
|---|
| 270 | end;
|
|---|
| 271 |
|
|---|
| 272 | function TModulePortal.ShowFooter(Session: TWebSession): string;
|
|---|
| 273 | begin
|
|---|
| 274 | Result := '';
|
|---|
| 275 | //Time := Round(Now - $ScriptTimeStart, 2);
|
|---|
| 276 | Result := Result + '<div id="Footer">' +
|
|---|
| 277 | '<i>| Správa webu: ' + Core.Core.Admin + ' | e-mail: ' + Core.Core.AdminEmail + ' |';
|
|---|
| 278 | // if Core.ShowRuntimeInfo then Output := Output + ' Doba generování: ' +
|
|---|
| 279 | // Time + ' s / ' + ini_get('max_execution_time') + ' s | Použitá paměť: ' +
|
|---|
| 280 | // HumanSize(memory_get_peak_usage(FALSE)) + ' / ' + ini_get('memory_limit') + 'B |';
|
|---|
| 281 | Result := Result + '</i></div></body></html>';
|
|---|
| 282 | end;
|
|---|
| 283 |
|
|---|
| 284 | end.
|
|---|
| 285 |
|
|---|
