| 1 | unit UCore;
|
|---|
| 2 |
|
|---|
| 3 | {$mode delphi}{$H+}
|
|---|
| 4 |
|
|---|
| 5 | interface
|
|---|
| 6 |
|
|---|
| 7 | uses
|
|---|
| 8 | USqlDatabase;
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 | TArrayOfString = array of string;
|
|---|
| 12 | TPageProducer = function: string;
|
|---|
| 13 |
|
|---|
| 14 | function InsertIcon(FileName: string): string;
|
|---|
| 15 | function HtmlLink(Text, Target: string): string;
|
|---|
| 16 | function ShowHeader(Title, Path: string): string;
|
|---|
| 17 | function ShowFooter: string;
|
|---|
| 18 | function Explode(Separator: Char; Data: string): TArrayOfString;
|
|---|
| 19 | function HumanDate(Date: string): string;
|
|---|
| 20 | procedure RegisterPage(Name: string; Producer: TPageProducer);
|
|---|
| 21 | function PagesList(URL: string; Page, TotalCount, CountPerPage: Integer): string;
|
|---|
| 22 | function StrRepeat(Data: string; Count: Integer): string;
|
|---|
| 23 | function FormatOutput(Data: string): string;
|
|---|
| 24 |
|
|---|
| 25 | type
|
|---|
| 26 | TRegistredPage = record
|
|---|
| 27 | Name: string;
|
|---|
| 28 | Producer: TPageProducer;
|
|---|
| 29 | end;
|
|---|
| 30 |
|
|---|
| 31 | var
|
|---|
| 32 | Pages: array of TRegistredPage;
|
|---|
| 33 | Database: TSqlDatabase;
|
|---|
| 34 |
|
|---|
| 35 | implementation
|
|---|
| 36 |
|
|---|
| 37 | uses
|
|---|
| 38 | pwenvvar, pwmain, SysUtils, UConfig;
|
|---|
| 39 |
|
|---|
| 40 | procedure RegisterPage(Name: string; Producer: TPageProducer);
|
|---|
| 41 | begin
|
|---|
| 42 | SetLength(Pages, Length(Pages) + 1);
|
|---|
| 43 | Pages[High(Pages)].Name := Name;
|
|---|
| 44 | Pages[High(Pages)].Producer := Producer;
|
|---|
| 45 | end;
|
|---|
| 46 |
|
|---|
| 47 | function HtmlLink(Text, Target: string): string;
|
|---|
| 48 | begin
|
|---|
| 49 | Result := '<a href="' + Target + '">' + Text + '</a>';
|
|---|
| 50 | end;
|
|---|
| 51 |
|
|---|
| 52 | function ShowHeader(Title, Path: string): string;
|
|---|
| 53 | var
|
|---|
| 54 | Navigace: string;
|
|---|
| 55 | begin
|
|---|
| 56 | Navigace := CgiEnvVar.RequestURI;
|
|---|
| 57 | Result := '<?xml version="1.0" encoding="utf-8"?>' +
|
|---|
| 58 | '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' +
|
|---|
| 59 | '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">' +
|
|---|
| 60 | '<head>' +
|
|---|
| 61 | ' <meta http-equiv="Content-Language" content="cs" />' +
|
|---|
| 62 | ' <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />' +
|
|---|
| 63 | ' <link rel="stylesheet" href="style/style.css" type="text/css" media="all" />' +
|
|---|
| 64 | ' <script type="text/javascript" src="style/global.js"></script>' +
|
|---|
| 65 | ' <title>Centrála - ' + Path + '</title>' +
|
|---|
| 66 | ' </head><body>' +
|
|---|
| 67 | '<div class="PageTitle">' + Title + '</div>'+
|
|---|
| 68 | '<div class="Navigation"><strong>Navigace >></strong> ' + Navigace + '</div>';
|
|---|
| 69 | end;
|
|---|
| 70 |
|
|---|
| 71 | function ShowFooter: string;
|
|---|
| 72 | var
|
|---|
| 73 | UpdateDate: string;
|
|---|
| 74 | GenerateTime: string;
|
|---|
| 75 | begin
|
|---|
| 76 | UpdateDate := '2.5.2007';
|
|---|
| 77 | GenerateTime := '1 s';
|
|---|
| 78 | Result := '<div class="Footer">| Web mistr: Jiří Hajda | e-mail: robie@centrum.cz | ICQ: 277158770 | Vygenerováno za ' + GenerateTime + ' s | Verze: 1.0 | Naposledy aktualizováno: ' + UpdateDate + ' |' +
|
|---|
| 79 | '</div>';
|
|---|
| 80 | //ShowArray($GLOBALS);
|
|---|
| 81 | Result := Result + '</body></html>';
|
|---|
| 82 | end;
|
|---|
| 83 |
|
|---|
| 84 | function Explode(Separator: Char; Data: string): TArrayOfString;
|
|---|
| 85 | begin
|
|---|
| 86 | SetLength(Result, 0);
|
|---|
| 87 | while Pos(Separator, Data) > 0 do begin
|
|---|
| 88 | SetLength(Result, Length(Result) + 1);
|
|---|
| 89 | Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1);
|
|---|
| 90 | Delete(Data, 1, Pos(Separator, Data));
|
|---|
| 91 | end;
|
|---|
| 92 | SetLength(Result, Length(Result) + 1);
|
|---|
| 93 | Result[High(Result)] := Data;
|
|---|
| 94 | end;
|
|---|
| 95 |
|
|---|
| 96 | function HumanDate(Date: string): string;
|
|---|
| 97 | var
|
|---|
| 98 | Parts: TArrayOfString;
|
|---|
| 99 | Parts2: TArrayOfString;
|
|---|
| 100 | begin
|
|---|
| 101 | Parts := Explode(' ', Date);
|
|---|
| 102 | // Result := Date;
|
|---|
| 103 | Parts2 := Explode('-', Parts[0]);
|
|---|
| 104 | if Date <> '0000-00-00' then Result := IntToStr(StrToInt(Parts2[2])*1) + '.' + IntToStr(StrToInt(Parts2[1])*1) + '.' + Parts2[0]
|
|---|
| 105 | else Result := ' ';
|
|---|
| 106 | end;
|
|---|
| 107 |
|
|---|
| 108 | function InsertIcon(FileName: string): string;
|
|---|
| 109 | begin
|
|---|
| 110 | Result := '<img alt="" src="images/favicons/' + FileName + '" width="16" height="16" />';
|
|---|
| 111 | end;
|
|---|
| 112 |
|
|---|
| 113 | procedure Init;
|
|---|
| 114 | var
|
|---|
| 115 | DbRows: TDbRows;
|
|---|
| 116 | begin
|
|---|
| 117 | Database := TSqlDatabase.Create;
|
|---|
| 118 | with Database do begin
|
|---|
| 119 | Hostname := DatabaseHostName;
|
|---|
| 120 | Database := DatabaseDatabase;
|
|---|
| 121 | UserName := DatabaseUserName;
|
|---|
| 122 | Password := DatabasePassword;
|
|---|
| 123 | Connect;
|
|---|
| 124 | end;
|
|---|
| 125 | DbRows := Database.Query('SET NAMES utf8');
|
|---|
| 126 | DbRows.Free;
|
|---|
| 127 | end;
|
|---|
| 128 |
|
|---|
| 129 | procedure Done;
|
|---|
| 130 | begin
|
|---|
| 131 | Database.Free;
|
|---|
| 132 | end;
|
|---|
| 133 |
|
|---|
| 134 | function PagesList(URL: string; Page, TotalCount, CountPerPage: Integer): string;
|
|---|
| 135 | const
|
|---|
| 136 | Around: Integer = 10;
|
|---|
| 137 | var
|
|---|
| 138 | Count: Integer;
|
|---|
| 139 | PagesMax: Integer;
|
|---|
| 140 | PagesMin: Integer;
|
|---|
| 141 | I: Integer;
|
|---|
| 142 | begin
|
|---|
| 143 | Count := Round(TotalCount / CountPerPage);
|
|---|
| 144 | Result := '';
|
|---|
| 145 | if Count > 1 then begin
|
|---|
| 146 | if Page > 0 then begin
|
|---|
| 147 | Result := Result + '<a href="' + URL + '0"><<</a> ';
|
|---|
| 148 | Result := Result + '<a href="' + URL + IntToStr(Page - 1) + '"><</a> ';
|
|---|
| 149 | end;
|
|---|
| 150 | PagesMax := Count - 1;
|
|---|
| 151 | PagesMin := 0;
|
|---|
| 152 | if PagesMax > (Page + Around) then PagesMax := Page + Around;
|
|---|
| 153 | if PagesMin < (Page - Around) then begin
|
|---|
| 154 | Result := Result + ' .. ';
|
|---|
| 155 | PagesMin := Page - Around;
|
|---|
| 156 | end;
|
|---|
| 157 | for I := PagesMin to PagesMax do begin
|
|---|
| 158 | if I = Page then Result := Result + '<strong>';
|
|---|
| 159 | Result := Result + '<a href="' + URL + IntToStr(I) + '">' + IntToStr(I + 1) + '</a> ';
|
|---|
| 160 | if I = Page then Result := Result + '</strong>';
|
|---|
| 161 | end;
|
|---|
| 162 | if PagesMax < (Count - 1) then Result := Result + ' .. ';
|
|---|
| 163 | if Page < (Count - 1) then begin
|
|---|
| 164 | Result := Result + '<a href="' + URL + IntToStr(Page + 1) + '">></a> ';
|
|---|
| 165 | Result := Result + '<a href="' + URL + IntToStr(Count - 1) + '">>></a>';
|
|---|
| 166 | end;
|
|---|
| 167 | end;
|
|---|
| 168 | end;
|
|---|
| 169 |
|
|---|
| 170 | function StrRepeat(Data: string; Count: Integer): string;
|
|---|
| 171 | var
|
|---|
| 172 | I: Integer;
|
|---|
| 173 | begin
|
|---|
| 174 | Result := '';
|
|---|
| 175 | for I := 1 to Count do
|
|---|
| 176 | Result := Result + Data;
|
|---|
| 177 | end;
|
|---|
| 178 |
|
|---|
| 179 | function FormatOutput(Data: string): string;
|
|---|
| 180 | var
|
|---|
| 181 | BlockStart, BlockEnd: Integer;
|
|---|
| 182 | Indention: Integer;
|
|---|
| 183 | Indention2: Integer;
|
|---|
| 184 | Line: string;
|
|---|
| 185 | Command: string;
|
|---|
| 186 | begin
|
|---|
| 187 | Result := '';
|
|---|
| 188 | Indention := 0;
|
|---|
| 189 | Indention2 := 0;
|
|---|
| 190 | while Data <> '' do begin
|
|---|
| 191 | //WebWrite('.');
|
|---|
| 192 | BlockStart := Pos('<', Data);
|
|---|
| 193 | BlockEnd := Pos('>', Data);
|
|---|
| 194 | if BlockStart > 1 then begin
|
|---|
| 195 | BlockEnd := BlockStart - 1;
|
|---|
| 196 | BlockStart := 1;
|
|---|
| 197 | end;
|
|---|
| 198 | Line := Trim(Copy(Data, BlockStart, BlockEnd));
|
|---|
| 199 | //WebWriteLn(Line);
|
|---|
| 200 | if Length(Line) > 0 then
|
|---|
| 201 | if Line[1] = '<' then begin
|
|---|
| 202 | if Data[BlockStart + 1] = '/' then begin
|
|---|
| 203 | Indention := Indention - 2;
|
|---|
| 204 | Indention2 := Indention;
|
|---|
| 205 | end else begin
|
|---|
| 206 | if Pos(' ', Line) > 0 then Command := Copy(Line, 2, Pos(' ', Line) - 2)
|
|---|
| 207 | else Command := Copy(Line, 2, Length(Line) - 2);
|
|---|
| 208 | //WebWriteLn(Command + ' ' + IntToStr(Indention));
|
|---|
| 209 | if Pos('</' + Command + '>', Data) > 0 then Indention := Indention + 2;
|
|---|
| 210 | //WebWriteLn(IntToStr(Indention) + ',' + IntToStr(Indention2));
|
|---|
| 211 | end;
|
|---|
| 212 | end;
|
|---|
| 213 | if Line <> '' then Result := Result + StrRepeat(' ', Indention2) + Line + #13#10;
|
|---|
| 214 | Data := Copy(Data, BlockEnd + 1, Length(Data));
|
|---|
| 215 | Indention2 := Indention;
|
|---|
| 216 | end;
|
|---|
| 217 | end;
|
|---|
| 218 |
|
|---|
| 219 | initialization
|
|---|
| 220 |
|
|---|
| 221 | Init;
|
|---|
| 222 |
|
|---|
| 223 | finalization
|
|---|
| 224 |
|
|---|
| 225 | Done;
|
|---|
| 226 | end.
|
|---|
