Changeset 103


Ignore:
Timestamp:
Oct 8, 2012, 8:48:16 AM (12 years ago)
Author:
chronos
Message:
  • Upraveno: TWebSession zobecněno pro možnost implementace více modulů s obsluhou vstupní stránky.
Location:
trunk
Files:
1 added
29 edited

Legend:

Unmodified
Added
Removed

  • trunk/Application/UWebObjects.pas

    r100 r103  
    6767    ClassId: string;
    6868    function AddNewGroup: TQueryFormGroup;
    69     function AddNewAction: TQueryAction;
     69    function AddNewAction(Caption, Action: string): TQueryAction;
    7070    procedure Load(Items: TDictionaryStringString);
    7171    constructor Create;
    … …  
    192192end;
    193193
    194 function TQueryForm.AddNewAction: TQueryAction;
     194function TQueryForm.AddNewAction(Caption, Action: string): TQueryAction;
    195195begin
    196196  Result := TQueryAction(Actions.AddNew(TQueryAction.Create));
     197  Result.Caption := Caption;
     198  Result.Action := Action;
    197199end;
    198200

  • trunk/Application/UWebSession.pas

    r102 r103  
    77uses
    88  Classes, SysUtils, UHTTPServer, USqlDatabase, UHTTPSessionMySQL, UUser,
    9   UHtmlClasses, UWebPage;
     9  UHtmlClasses, UWebPage, UUtils, UXmlClasses, DateUtils;
    1010
    1111type
    … …  
    1414  TWebSession = class(THTTPHandlerData)
    1515  private
    16     procedure TopMenu;
    17     procedure Footer;
    1816  public
    1917    MainModule: TObject;
    … …  
    2725    procedure LoadUserInfo;
    2826    procedure InitDatabase;
    29     procedure GeneratePage(Page: TWebPage);
    3027    constructor Create; override;
    3128    destructor Destroy; override;
     29    procedure GeneratePage(Page: TWebPage);
    3230  end;
    3331
     32  TGeneratePageEvent = procedure (Session: TWebSession; Page: TWebPage) of object;
    3433
    3534implementation
     35
     36uses
     37  UCore;
    3638
    3739{ TWebSession }
    … …  
    6062end;
    6163
     64procedure TWebSession.GeneratePage(Page: TWebPage);
     65begin
     66  with TCore(MainModule) do
     67  if Assigned(GeneratePage) then GeneratePage(Self, Page)
     68    else GeneratePageDefault(Self, Page);
     69end;
     70
    6271procedure TWebSession.InitDatabase;
    6372var
    … …  
    6574begin
    6675  with Database do begin
     76    Encoding := 'utf8';
    6777    Connect;
    68   end;
    69   try
    70     DbRows := TDbRows.Create;
    71     Database.Query(DbRows, 'SET NAMES utf8');
    72   finally
    73     DbRows.Free;
    7478  end;
    7579end;
    … …  
    7781procedure TWebSession.LoadUserInfo;
    7882begin
    79   if MainModule.ModuleManager.ModuleRunning('User') then begin
     83  if TCore(MainModule).ModuleManager.ModuleRunning('User') then begin
    8084    User.HandlerData := Self;
    8185    UserOnline.HandlerData := Self;
    … …  
    8690end;
    8791
    88 procedure TWebSession.GeneratePage(Page: TWebPage);
    89 var
    90   I: Integer;
    91   TitleTag: THtmlString;
    92 begin
    93     HtmlDocument.ContentLanguage := 'cs';
    94     GlobalTitle := 'ZděchovNET';
    95     HtmlDocument.Styles.Add(NavigationLink('/Style/' + MainModule.Style + '/Style.css'));
    96     HtmlDocument.Scripts.Add(NavigationLink('/Style/' + MainModule.Style + '/Global.js'));
    97     HtmlDocument.Scripts.Add(NavigationLink('/Style/' + MainModule.Style + '/jquery.js'));
    98 
    99       TitleTag := THtmlString.Create;
    100       HtmlDocument.Body.SubItems.Insert(0, TitleTag);
    101       TopMenu;
    102       //Page.Page.OnProduce(HandlerData);
    103       HtmlDocument.Title := Page.Caption;
    104       TitleTag.Text := '<div class="TitlePanel"><span class="GlobalTitle">' + GlobalTitle +
    105         '</span> - ' + HtmlDocument.Title + '</div>';
    106       HtmlDocument.Title := GlobalTitle + ' - ' + HtmlDocument.Title;
    107       with HtmlDocument.AsXmlDocument do
    108       try
    109         Formated := MainModule.FormatHTML;
    110         Response.Content.WriteString(AsString);
    111       finally
    112         Free;
    113       end;
    114 end;
    115 
    11692end.
    11793

  • trunk/Modules/Portal/UModulePortal.pas

    r102 r103  
    66
    77uses
    8   Classes, SysUtils, UModularSystem, SpecializedDictionary, USqlDatabase;
     8  Classes, SysUtils, UModularSystem, SpecializedDictionary, USqlDatabase,
     9  UUtils, UWebSession, SpecializedList, UUser;
    910
    1011type
    … …  
    1415  TModulePortal = class(TModule)
    1516  private
     17    Time: TDateTime;
     18    function ShowFooter(Session: TWebSession): string;
     19    function ShowHeader(Session: TWebSession): string;
    1620  public
    1721    constructor Create(Owner: TComponent); override;
    … …  
    4044  License := 'GNU/LGPL v3';
    4145  Author := 'Chronosoft';
     46  Dependencies.Add('User');
    4247end;
    4348
    … …  
    6974
    7075    Core.CommonDatabase.Query(DbRows,
    71     'CREATE TABLE IF NOT EXISTS `User` (' +
    72     '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
    73     '  `Name` varchar(255) NOT NULL,' +
    74     '  `FullName` varchar(255) NOT NULL,' +
    75     '  `Password` varchar(255) NOT NULL,' +
    76     '  `Salt` varchar(255) NOT NULL,' +
    77     '  `Email` varchar(255) NOT NULL,' +
    78     '  `RegistrationTime` datetime NOT NULL,' +
     76    'CREATE TABLE IF NOT EXISTS `Panel` (' +
     77    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     78    '  `Module` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     79    '  `Parameters` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     80    '  `Order` int(11) NOT NULL,' +
     81    '  `PanelColumn` int(11) NOT NULL,' +
     82    '  PRIMARY KEY (`Id`),' +
     83    '  KEY `PanelColumn` (`PanelColumn`)' +
     84    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     85
     86    Core.CommonDatabase.Query(DbRows,
     87    'CREATE TABLE IF NOT EXISTS `PanelColumn` (' +
     88    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     89    '  `Width` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
    7990    '  PRIMARY KEY (`Id`)' +
    80     ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 AUTO_INCREMENT=1 ;');
    81 
    82     Data.Add('Id', '1');
    83     Data.Add('Name', 'anonymous');
    84     Data.Add('FullName', 'Anonymous');
    85     Data.Add('RegistrationTime', 'NOW()');
    86     Data.Add('Password', '');
    87     Data.Add('Salt', '');
    88     Data.Add('Email', '');
    89     Core.CommonDatabase.Insert('User', Data);
    90 
    91     Core.CommonDatabase.Query(DbRows,
    92     'CREATE TABLE IF NOT EXISTS `UserOnline` (' +
    93     '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
    94     '  `User` int(11) NOT NULL DEFAULT ''0'',' +
    95     '  `ActivityTime` datetime NOT NULL DEFAULT ''0000-00-00 00:00:00'',' +
    96     '  `LoginTime` datetime NOT NULL DEFAULT ''0000-00-00 00:00:00'',' +
    97     '  `SessionId` varchar(255) COLLATE utf8_czech_ci NOT NULL DEFAULT '''',' +
    98     '  `IpAddress` varchar(16) COLLATE utf8_czech_ci NOT NULL DEFAULT '''',' +
    99     '  `HostName` varchar(255) COLLATE utf8_czech_ci NOT NULL DEFAULT '''',' +
    100     '  `ScriptName` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     91    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     92
     93    Core.CommonDatabase.Query(DbRows,
     94    'ALTER TABLE `Panel`' +
     95    '  ADD CONSTRAINT `Panel_ibfk_1` FOREIGN KEY (`PanelColumn`) REFERENCES `panelcolumn` (`Id`);');
     96
     97    Core.CommonDatabase.Query(DbRows,
     98    'CREATE TABLE IF NOT EXISTS `HyperlinkGroup` (' +
     99    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     100    '  `Name` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     101    '  PRIMARY KEY (`Id`)' +
     102    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     103
     104    Core.CommonDatabase.Query(DbRows,
     105    'CREATE TABLE IF NOT EXISTS `Hyperlink` (' +
     106    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     107    '  `Name` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     108    '  `URL` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     109    '  `Group` int(11) NOT NULL,' +
     110    '  `IconFile` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     111    '  `PermissionModule` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     112    '  `PermissionOperation` varchar(255) COLLATE utf8_czech_ci NOT NULL,' +
     113    '  `Enable` int(11) NOT NULL DEFAULT "1",' +
    101114    '  PRIMARY KEY (`Id`),' +
    102     '  KEY `User` (`User`)' +
    103     ') ENGINE=MEMORY  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     115    '  KEY `Group` (`Group`),' +
     116    '  KEY `Enable` (`Enable`)' +
     117    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     118
     119    Core.CommonDatabase.Query(DbRows,
     120    'ALTER TABLE `Hyperlink`' +
     121    '  ADD CONSTRAINT `Hyperlink_ibfk_1` FOREIGN KEY (`Group`) REFERENCES `hyperlinkgroup` (`Id`);');
     122
    104123  finally
    105124    Data.Free;
    … …  
    116135  try
    117136    DbRows := TDbRows.Create;
    118     Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `User`');
    119     Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `UserOnline`');
     137    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `Panel`');
     138    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `PanelColumn`');
     139    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `Hyperlink`');
     140    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `HyperlinkGroup`');
    120141  finally
    121142    DbRows.Free;
    … …  
    128149end;
    129150
     151function TModulePortal.ShowHeader(Session: TWebSession): string;
     152var
     153  ScriptName: string;
     154  PathTreePath: string;
     155  Navigation: string;
     156  ScriptNameParts: TListString;
     157  ScriptNamePart: string;
     158  I: Integer;
     159  BodyParam: string;
     160  Path: string;
     161  Output: string;
     162begin
     163  try
     164    ScriptNameParts := TListString.Create;
     165
     166    //ScriptName := $_SERVER['SCRIPT_NAME'];
     167    while Pos('//', ScriptName) > 0 do
     168      ScriptName := StringReplace('//', '/', ScriptName, [rfReplaceAll]);
     169    PathTreePath := '/';
     170    //PathTreeItem := PathTree;
     171    //Navigation := '<a href="' + NavigationLink(PathTreePath) + '">' + PathTreeItem[0] + '</a> &gt; ';
     172    ScriptName := Copy(ScriptName, Length(Core.BaseURL), Length(ScriptName));
     173    ScriptNameParts.Explode(ScriptName, '/', StrToStr);
     174    ScriptNameParts.Delete(0);
     175    (*
     176    for I := 0 to ScriptNameParts.Count - 1 do begin
     177      ScriptNamePart := ScriptNameParts[I];
     178      //echo($ScriptNamePart.'<br />');
     179      if array_key_exists($ScriptNamePart, $PathTreeItem) then begin
     180        if  is_array($PathTreeItem[$ScriptNamePart]) then begin
     181
     182          PathTreeItem = $PathTreeItem[$ScriptNamePart];
     183          PathTreePath .= $ScriptNamePart.'/';
     184          if PathTreeItem[0] != '' then
     185            Navigation := Navigation + '<a href="' + $this->System->Config['Web']['RootFolder'] + PathTreePath + '">' + PathTreeItem[0] + '</a> &gt; ';
     186        end else begin
     187          if(PathTreeItem[ScriptNamePart] != '')
     188            Navigation := Navigation + '<a href="' + $this->System->Config['Web']['RootFolder'].$PathTreePath.$ScriptNamePart.'">'.$PathTreeItem[$ScriptNamePart].'</a> &gt; ';
     189        end;
     190      end;
     191    end;    *)
     192    Navigation := Copy(Navigation, 1, Length(Navigation) - 6);
     193
     194    BodyParam := '';
     195    //if(isset($this->Load)) BodyParam := BodyParam + ' onload="'.$this->Load.'"';
     196    //if(isset($this->Unload)) BodyParam := BodyParam + ' onunload="'.$this->Unload.'"';
     197    Output := '<?xml version="1.0" encoding="' + Core.Charset + '"?>' + LineEnding +
     198    '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' +
     199    '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="cs" lang="cs">' +
     200    '<head><link rel="stylesheet" href="' + NavigationLink('/style/' + Core.Style + '/style.css') + '" type="text/css" media="all" />' +
     201    '<meta http-equiv="content-type" content="application/xhtml+xml; charset=' + Core.Charset + '" />' +
     202    '<script type="text/javascript" src="' + Core.BaseURL + '/style/' + Core.Style + '/global.js"></script>' +
     203    '<title>' + Session.GlobalTitle + ' - ' + Path + '</title>' +
     204    '</head><body' + BodyParam + '>' +
     205    '<div id="Title">' + Title + '</div>' +
     206    '<div class="Navigation"><span class="MenuItem"><strong>Navigace :: </strong> ';
     207    Output := Output + Navigation + '</span><div class="MenuItem2">';
     208    if Session.User.Id = UnknownUser then
     209      Output := Output + '<a href="' + MakeLink('Přihlášení',
     210        NavigationLink('/?Action=LoginForm')) + ' ' +
     211        MakeLink('Registrace', NavigationLink('/?Action=UserRegister'))
     212      else Output := Output + Session.User.Name + ' ' + MakeLink('Odhlásit',
     213        NavigationLink('/?Action=Logout'));
     214// <a href="'.$this->System->Config['Web']['RootFolder'].'/?Action=UserOptions">Nastavení</a>';
     215  Output := Output + '</div></div>';
     216  Result := Output;
     217  finally
     218    ScriptNameParts.Free;
     219  end;
     220end;
     221
     222function TModulePortal.ShowFooter(Session: TWebSession): string;
     223begin
     224  //Time := Round(Now - $ScriptTimeStart, 2);
     225  Result := Result + '<div id="Footer">' +
     226    '<i>| Správa webu: ' + Core.Admin + ' | e-mail: ' + Core.AdminEmail + ' |';
     227//    if Core.ShowRuntimeInfo then Output := Output + ' Doba generování: ' +
     228//     Time + ' s / ' + ini_get('max_execution_time') + ' s | Použitá paměť: ' +
     229//     HumanSize(memory_get_peak_usage(FALSE)) + ' / ' + ini_get('memory_limit') + 'B |';
     230  Result := Result + '</i></div></body></html>';
     231end;
     232
    130233end.
    131234

  • trunk/Modules/Portal/UPagePortal.pas

    r102 r103  
    77uses
    88  Classes, SysUtils, FileUtil, UWebPage, UHTTPServer, USqlDatabase, UUtils,
    9   SpecializedDictionary;
     9  SpecializedDictionary, UWebSession, SpecializedList;
    1010
    1111type
    … …  
    1717  private
    1818    Session: TWebSession;
     19    function ShowPanel(Title, Content: string; Menu: TListString = nil): string;
     20    function SystemMessage(Title, Text: string): string;
    1921    function ShowLinks(GroupId: Integer): string;
     22    function Show: string;
     23    function OnlineHostList: string;
     24    function UserPanel: string;
     25    function WebcamPanel: string;
    2026  public
    2127    { public declarations }
    … …  
    3036
    3137uses
    32   UCore;
     38  UCore, UModuleUser, UWebObjects, UUser;
     39
     40function TWebPagePortal.SystemMessage(Title, Text: string): string;
     41begin
     42  Result := '<table align="center"><tr><td><div class="SystemMessage"><h3>' +
     43    Title + '</h3><div>' + Text + '</div></div</td></tr></table>';
     44end;
    3345
    3446procedure TWebPagePortal.DataModuleProduce(HandlerData: THTTPHandlerData);
    3547begin
    36   Session := TWebSessionHandlerData);
     48  Session := TWebSession(HandlerData);
    3749  with TWebSession(HandlerData) do begin
    3850
    … …  
    5062    HyperlinkGroups := TDbRows.Create;
    5163    Hyperlinks := TDbRows.Create;
    52     Database.Query(HyperlinkGroups, 'SELECT * FROM `HyperlinkGroup` WHERE `Id`=' + IntToStr(GroupId));
     64    Session.Database.Query(HyperlinkGroups, 'SELECT * FROM `HyperlinkGroup` WHERE `Id`=' + IntToStr(GroupId));
    5365
    5466    Result := '';
    55     Database.Query(Hyperlinks, 'SELECT * FROM `Hyperlink` WHERE (`Group`=' + IntToStr(GroupId) + ') AND (`Enable` = 1)');
     67    Session.Database.Query(Hyperlinks, 'SELECT * FROM `Hyperlink` WHERE (`Group`=' + IntToStr(GroupId) + ') AND (`Enable` = 1)');
    5668    for I := 0 to HyperLinks.Count - 1 do begin
    5769      HyperLink := Hyperlinks[I];
    … …  
    6072        if Copy(HyperLink.Values['URL'], 1, 4) <> 'http' then
    6173          HyperLink.Values['URL'] := NavigationLink(HyperLink.Values['URL']);
    62         if((HyperLink.Values['PermissionModule'] = '') or
     74        if ((HyperLink.Values['PermissionModule'] = '') or
    6375        ((HyperLink.Values['PermissionModule'] <> '') and
    64         Session.->Modules['User']->CheckPermission(HyperLink.Values['PermissionModule'], HyperLink.Values['PermissionOperation'])))
    65         Result := Result + '<img alt="' + HyperLink.Values['Name'] + '" src="images/favicons/'.$HyperLink.Values['IconFile'].'" width="16" height="16" /> <a href="' + $HyperLink.Values['URL'] + '">' + HyperLink.Values['Name'] + '</a><br />';
     76        Session.User.CheckPermission(HyperLink.Values['PermissionModule'], HyperLink.Values['PermissionOperation']))) then
     77        Result := Result + '<img alt="' + HyperLink.Values['Name'] + '" src="images/favicons/' + HyperLink.Values['IconFile'] + '" width="16" height="16" /> <a href="' + HyperLink.Values['URL'] + '">' + HyperLink.Values['Name'] + '</a><br />';
    6678    end;
    67     Result := Panel(HyperlinkGroup['Name'], Result);
     79    Result := ShowPanel(HyperlinkGroups[0].Values['Name'], Result);
    6880
    6981  finally
    … …  
    7385end;
    7486
     87function TWebPagePortal.Show: string;
     88var
     89  Output: string;
     90  Form: TQueryForm;
     91  UserOptions: TQueryForm;
     92  PanelColumn: TDictionaryStringString;
     93  Panel: TDictionaryStringString;
     94  Width: string;
     95  DbRows: TDbRows;
     96  DbRows2: TDbRows;
     97  I, J: Integer;
     98begin
     99  Output := '';
     100  with Session.Request do
     101  if Query.SearchKey('Action') <> -1 then begin
     102    if Query.Values['Action'] = 'CustomizeNewsSave' then begin
     103      //Output := $this->System->Modules['News']->CustomizeSave();
     104    end else
     105    if Query.Values['Action'] = 'LoginForm' then begin
     106      Form := TQueryForm.Create; // UserLogin
     107      Form.AddNewAction('Přihlásit', '?Action=Login');
     108      Output := Output + Form.AsXmlElement.AsString;
     109      Output := Output + '<div class="Centred"><a href="?Action=UserRegister">Registrovat se</a> ' +
     110        '<a href="?Action=PasswordRecovery">Obnova zapomenutého hesla</a></div>';
     111    end else
     112    if Query.Values['Action'] = 'Login' then begin
     113      Form := TQueryForm.Create; // UserLogin
     114      Form.Load(Session.Request.Post);
     115      Session.UserOnline.Login(
     116        Session.User.GetIdByNamePassword(
     117      TQueryFormGroup(Form.Groups[0]).Rows.FindByName('Username').Value.Value,
     118        TQueryFormGroup(Form.Groups[0]).Rows.FindByName('Password').Value.Value));
     119      Output := Output + SystemMessage('Přihlášení', Result);
     120      if Session.User.Id <> UnknownUser then begin
     121        //Form.LoadValuesFromForm;
     122        TQueryFormGroup(Form.Groups[0]).Rows.FindByName('Password').Value.Value := '';
     123        Output := Output + Form.AsXmlElement.AsString;
     124        Output := Output + '<div class="Centred"><a href="?Action=UserRegister">Registrovat se</a> ' +
     125          '<a href="?Action=PasswordRecovery">Obnova zapomenutého hesla</a></div>';
     126      end;
     127    end else
     128    if Query.Values['Action'] = 'Logout' then begin
     129      Session.UserOnline.Logout;
     130      Output := Output + SystemMessage('Odhlášení', 'Uživatel odhlášen');
     131    end else
     132    if Query.Values['Action'] = 'UserOptions' then begin
     133      UserOptions := TQueryForm.Create; // UserOptions
     134      //UserOptions.LoadValuesFromDatabase(Session.User.Id);
     135      UserOptions.AddNewAction('Uložit', '?Action=UserOptionsSave');
     136      Output := Output + UserOptions.AsXmlElement.AsString;
     137    end else
     138    if Query.Values['Action'] = 'UserOptionsSave' then begin
     139      UserOptions := TQueryForm.Create; // UserOptions
     140      UserOptions.Load(Session.Request.Post);
     141      //UserOptions.SaveValuesToDatabase($this->System->Modules['User']->User['Id']);
     142      Output := Output + SystemMessage('Nastavení', 'Nastavení uloženo.');
     143      //this->System->Modules['Log']->NewRecord('User', 'Nastavení uživatele změněno', $UserOptions->Values['Name']);
     144      //UserOptions.LoadValuesFromDatabase($this->System->Modules['User']->User['Id']);
     145      UserOptions.AddNewAction('Uložit', '?Action=UserOptionsSave');
     146      Output := Output + UserOptions.AsXmlElement.AsString;
     147    end else
     148    if Query.Values['Action'] = 'UserRegister' then begin
     149      Form := TQueryForm.Create; //'UserRegister');
     150      Form.Load(Session.Request.Post);
     151      Form.AddNewAction('Uložit', '?Action=UserRegisterSave');
     152      Output := Output + Form.AsXmlElement.AsString;
     153    end else
     154    if Query.Values['Action'] = 'UserRegisterConfirm' then begin
     155      //Session.User.RegisterConfirm($_GET['User'], $_GET['H']);
     156      Output := Output + SystemMessage('Potvrzení registrace', 'Registrace potvrzena');
     157    end else
     158    if Query.Values['Action'] = 'PasswordRecovery' then begin
     159      Form := TQueryForm.Create; // PasswordRecovery
     160      Form.AddNewAction('Obnovit', '?Action=PasswordRecovery2');
     161      Output := Output + Form.AsXmlElement.AsString;
     162    end else
     163    if Query.Values['Action'] = 'PasswordRecovery2' then begin
     164      Form := TQueryForm.Create; // PasswordRecovery
     165      Form.Load(Session.Request.Post);
     166      //Result = Session.User.PasswordRecoveryRequest($Form->Values['Name'], $Form->Values['Email']);
     167      Output := Output + SystemMessage('Obnova hesla', Result);
     168      //if Result <> USER_PASSWORD_RECOVERY_SUCCESS then begin
     169        Output := Output + Form.AsXmlElement.AsString;
     170      //end;
     171    end else
     172    if Query.Values['Action'] = 'PasswordRecoveryConfirm' then begin
     173      //Session.User.PasswordRecoveryConfirm($_GET['User'], $_GET['H'], $_GET['P']);
     174      Output := Output + SystemMessage('Obnova hesla', 'Potvrzení obnovení hesla');
     175    end (*else
     176    if Query.Values['Action'] = 'UserRegisterSave' then begin
     177          Form := TQueryForm.Create; // UserRegister
     178          Form.Load(Session.Request.Post);
     179          Session.User.Register(Form->Values['Login'], $Form->Values['Password'], $Form->Values['Password2'], $Form->Values['Email'], $Form->Values['Name'], $Form->Values['PhoneNumber'], $Form->Values['ICQ']);
     180          $Output := Output + $this->SystemMessage('Registrace nového účtu', $Result);
     181          if Result <> USER_REGISTRATED then begin
     182            Form.OnSubmit := '?Action=UserRegisterSave';
     183            $Output := Output + Form.ShowEditForm;
     184      end;
     185    end else
     186    if Query.Values['Action'] = 'MemberOptions' then begin
     187          $UserOptions = new Form('MemberOptions');
     188          $DbResult = $this->Database->query('SELECT Member.Id, Member.InternetTariffNextMonth, Member.FamilyMemberCount, Member.BillingPeriodNext, Subject.Name, Subject.AddressStreet, Subject.AddressTown, Subject.AddressPSC, Subject.IC, Subject.DIC FROM Member JOIN Subject ON Subject.Id = Member.Subject WHERE Member.Id='.$this->System->Modules['User']->User['Member']);
     189          $DbRow = $DbResult->fetch_array();
     190          foreach($UserOptions->Definition['Items'] as $Index => $Item)
     191          begin
     192            $UserOptions->Values[$Index] = $DbRow[$Index];
     193          end;
     194          $UserOptions->OnSubmit = '?Action=MemberOptionsSave';
     195          $Output .= $UserOptions->ShowEditForm();
     196     end else
     197     if Query.Values['Action'] = 'MemberOptionsSave' then begin
     198          $UserOptions = new Form('MemberOptions');
     199          $UserOptions->LoadValuesFromForm();
     200          if($UserOptions->Values['FamilyMemberCount'] < 0)
     201            $UserOptions->Values['FamilyMemberCount'] = 0;
     202          if($UserOptions->Values['BillingPeriodNext'] < 2)
     203            $UserOptions->Values['BillingPeriodNext'] = 2;
     204
     205          $DbResult = $this->Database->update('Member', 'Id='.$this->System->Modules['User']->User['Member'], array('InternetTariffNextMonth' => $UserOptions->Values['InternetTariffNextMonth'], 'FamilyMemberCount' => $UserOptions->Values['FamilyMemberCount'], 'BillingPeriodNext' => $UserOptions->Values['BillingPeriodNext']));
     206          $DbResult = $this->Database->query('SELECT Subject FROM Member WHERE Id='.$this->System->Modules['User']->User['Member']);
     207          $Member = $DbResult->fetch_assoc();
     208          $DbResult = $this->Database->update('Subject', 'Id='.$Member['Subject'], array('Name' => $UserOptions->Values['Name'], 'AddressStreet' => $UserOptions->Values['AddressStreet'], 'AddressTown' => $UserOptions->Values['AddressTown'], 'AddressPSC' => $UserOptions->Values['AddressPSC'], 'IC' => $UserOptions->Values['IC'], 'DIC' => $UserOptions->Values['DIC']));
     209          $Output .= $this->SystemMessage('Nastavení', 'Nastavení domácnosti uloženo.');
     210          $this->System->Modules['Log']->NewRecord('Member+Subject', 'Nastavení člena/subjektu změněno', $UserOptions->Values['Name']);
     211          $DbResult = $this->Database->query('SELECT Member.Id, Member.InternetTariffNextMonth, Member.FamilyMemberCount, Member.BillingPeriodNext, Subject.Name, Subject.AddressStreet, Subject.AddressTown, Subject.AddressPSC, Subject.IC, Subject.DIC FROM Member JOIN Subject ON Subject.Id = Member.Subject WHERE Member.Id='.$this->System->Modules['User']->User['Member']);
     212          $DbRow = $DbResult->fetch_array();
     213          foreach($UserOptions->Definition['Items'] as $Index => $Item)
     214          {
     215            $UserOptions->Values[$Index] = $DbRow[$Index];
     216          }
     217          $UserOptions->OnSubmit = '?Action=MemberOptionsSave';
     218          $Output .= $UserOptions->ShowEditForm();
     219      end;
     220    end *);
     221
     222    //Session.Database.Database := Config['Database']['Database'];
     223
     224    // Show pannels
     225    //if(IsInternetAddr()) echo('Internet'); else echo('LAN');
     226    //$Output .= $this->InfoBar();
     227    Output := Output + '<table id="MainTable"><tr>';
     228    Session.Database.Select(DbRows, 'PanelColumn', '*');
     229    for I := 0 to DbRows.Count - 1 do begin
     230      PanelColumn := DbRows[I];
     231      if PanelColumn.Values['Width'] <> '' then
     232          Width := ' width="' + PanelColumn.Values['Width'] + '"'
     233        else Width := '';
     234      Output := Output + '<td valign="top"' + Width + '>';
     235      Session.Database.Query(DbRows2, 'SELECT * FROM `Panel` WHERE `PanelColumn`=' +
     236        PanelColumn.Values['Id'] + ' ORDER BY `Order`');
     237      for J := 0 to DbRows2.Count - 1 do
     238        Panel := DbRows[J];
     239        if Panel.Values['Module'] = 'HyperlinkGroup' then
     240          Output := Output + ShowLinks(StrToInt(Panel.Values['Parameters']))
     241        else if Panel.Values['Module'] = 'OnlineHostList' then
     242          Output := Output + ShowPanel('Online počítače', OnlineHostList)
     243        else if Panel.Values['Module'] = 'UserOptions' then
     244        begin
     245          if Session.User.Id <> UnknownUser then
     246            Output := Output + ShowPanel('Přihlášený uživatel', UserPanel);
     247        end else
     248        if Panel.Values['Module'] = 'Webcam' then
     249          Output := Output + ShowPanel('Kamery', WebcamPanel)
     250        else if Panel.Values['Module'] = 'NewsGroupList' then
     251//          Output := Output + Panel('Aktuality', $this->System->Modules['News']->Show(), array('<a href="?Action=CustomizeNews">Upravit</a>'));
     252      end;
     253      Output := Output + '</td>';
     254    end;
     255    Output := Output + '</table>';
     256    Result := Output;
     257  end;
     258
     259function TWebPagePortal.OnlineHostList: string;
     260begin
     261
     262end;
     263
     264function TWebPagePortal.UserPanel: string;
     265begin
     266
     267end;
     268
     269function TWebPagePortal.ShowPanel(Title, Content: string; Menu: TListString): string;
     270var
     271  I: Integer;
     272  TitleCombined: string;
     273begin
     274  TitleCombined := '';
     275  if Assigned(Menu) then
     276    if Menu.Count > 0 then
     277      for I := 0 to Menu.Count - 1 do
     278        TitleCombined := TitleCombined + '<div class="Action">' + Menu[I] + '</div>';
     279  Result := '<div class="Panel"><div class="Title">' + TitleCombined +
     280    '</div><div class="Content">' + Content + '</div></div>';
     281end;
     282
     283function TWebPagePortal.WebcamPanel: string;
     284begin
     285
     286end;
    75287
    76288end.

  • trunk/Modules/TV/UPageTV.pas

    r100 r103  
    3030
    3131uses
    32   UCore;
     32  UCore, UWebSession;
    3333
    3434{ TWebPageTV }

  • trunk/Modules/User/UModuleUser.pas

    r97 r103  
    8080    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 AUTO_INCREMENT=1 ;');
    8181
    82     Data.Add('Id', '1');
    83     Data.Add('Name', 'anonymous');
    84     Data.Add('FullName', 'Anonymous');
    85     Data.Add('RegistrationTime', 'NOW()');
    86     Data.Add('Password', '');
    87     Data.Add('Salt', '');
    88     Data.Add('Email', '');
    89     Core.CommonDatabase.Insert('User', Data);
    90 
    9182    Core.CommonDatabase.Query(DbRows,
    9283    'CREATE TABLE IF NOT EXISTS `UserOnline` (' +
    … …  
    10293    '  KEY `User` (`User`)' +
    10394    ') ENGINE=MEMORY  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     95
     96    Core.CommonDatabase.Query(DbRows,
     97    'CREATE TABLE IF NOT EXISTS `PermissionGroup` (' +
     98    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     99    '  `Description` varchar(255) COLLATE utf8_czech_ci NOT NULL DEFAULT "",' +
     100    '  PRIMARY KEY (`Id`)' +
     101    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     102
     103    Core.CommonDatabase.Query(DbRows,
     104    'CREATE TABLE IF NOT EXISTS `PermissionGroupAssignment` (' +
     105    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     106    '  `Group` int(11) NOT NULL DEFAULT "0",' +
     107    '  `AssignedGroup` int(11) DEFAULT NULL,' +
     108    '  `AssignedOperation` int(11) DEFAULT NULL,' +
     109    '  PRIMARY KEY (`Id`),' +
     110    '  KEY `Group` (`Group`),' +
     111    '  KEY `AssignedGroup` (`AssignedGroup`),' +
     112    '  KEY `AssignedOperation` (`AssignedOperation`)' +
     113    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     114
     115    Core.CommonDatabase.Query(DbRows,
     116    'CREATE TABLE IF NOT EXISTS `PermissionOperation` (' +
     117    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     118    '  `Module` varchar(64) COLLATE utf8_czech_ci NOT NULL DEFAULT "",' +
     119    '  `Operation` varchar(128) COLLATE utf8_czech_ci NOT NULL DEFAULT "",' +
     120    '  `Item` varchar(64) COLLATE utf8_czech_ci NOT NULL DEFAULT "",' +
     121    '  `ItemId` int(11) NOT NULL DEFAULT "0",' +
     122    '  PRIMARY KEY (`Id`),' +
     123    '  KEY `Module` (`Module`),' +
     124    '  KEY `Operation` (`Operation`),' +
     125    '  KEY `Item` (`Item`),' +
     126    '  KEY `ItemId` (`ItemId`)' +
     127    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     128
     129    Core.CommonDatabase.Query(DbRows,
     130    '  CREATE TABLE IF NOT EXISTS `PermissionUserAssignment` (' +
     131    '  `Id` int(11) NOT NULL AUTO_INCREMENT,' +
     132    '  `User` int(11) NOT NULL DEFAULT "0",' +
     133    '  `AssignedGroup` int(11) DEFAULT NULL,' +
     134    '  `AssignedOperation` int(11) DEFAULT NULL,' +
     135    '  PRIMARY KEY (`Id`),' +
     136    '  KEY `User` (`User`),' +
     137    '  KEY `AssignedGroup` (`AssignedGroup`),' +
     138    '  KEY `AssignedOperation` (`AssignedOperation`)' +
     139    ') ENGINE=InnoDB  DEFAULT CHARSET=utf8 COLLATE=utf8_czech_ci AUTO_INCREMENT=1 ;');
     140
     141    Core.CommonDatabase.Query(DbRows,
     142    'ALTER TABLE `PermissionGroupAssignment`' +
     143    '  ADD CONSTRAINT `PermissionGroupAssignment_ibfk_1` FOREIGN KEY (`Group`) REFERENCES `permissiongroup` (`Id`),' +
     144    '  ADD CONSTRAINT `PermissionGroupAssignment_ibfk_2` FOREIGN KEY (`AssignedGroup`) REFERENCES `permissiongroup` (`Id`),' +
     145    '  ADD CONSTRAINT `PermissionGroupAssignment_ibfk_3` FOREIGN KEY (`AssignedOperation`) REFERENCES `permissionoperation` (`Id`);');
     146
     147    Core.CommonDatabase.Query(DbRows,
     148    'ALTER TABLE `PermissionUserAssignment`' +
     149    '  ADD CONSTRAINT `PermissionUserAssignment_ibfk_1` FOREIGN KEY (`User`) REFERENCES `user` (`Id`),' +
     150    '  ADD CONSTRAINT `PermissionUserAssignment_ibfk_2` FOREIGN KEY (`AssignedGroup`) REFERENCES `permissiongroup` (`Id`),' +
     151    '  ADD CONSTRAINT `PermissionUserAssignment_ibfk_3` FOREIGN KEY (`AssignedOperation`) REFERENCES `permissionoperation` (`Id`);');
     152
     153
    104154  finally
    105155    Data.Free;
    … …  
    116166  try
    117167    DbRows := TDbRows.Create;
     168
     169    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `PermissionUserAssignment`');
     170    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `PermissionGroupAssignment`');
     171    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `PermissionGroup`');
     172    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `PermissionOperation`');
    118173    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `User`');
    119174    Core.CommonDatabase.Query(DbRows, 'DROP TABLE IF EXISTS `UserOnline`');

  • trunk/Modules/User/UUserControlPage.pas

    r100 r103  
    3232
    3333uses
    34   UCore, UUtils, UUser;
     34  UCore, UUtils, UUser, UWebSession;
    3535
    3636  { TUserControlPage }
    … …  
    8585        end;
    8686      end;
    87       with AddNewAction do begin
    88         Caption := 'Přihlásit';
    89         Action := 'Login';
    90       end;
     87      AddNewAction('Přihlásit', 'Login');
    9188    end;
    9289    if HandlerData.Request.Post.SearchKey('Login') <> -1 then begin
    … …  
    145142        end;
    146143      end;
    147       with AddNewAction do begin
    148         Caption := 'Registrovat';
    149         Action := 'Register';
    150       end;
     144      AddNewAction('Registrovat', 'Register');
    151145    end;
    152146    if HandlerData.Request.Post.SearchKey('Register') <> -1 then
    … …  
    217211        end;
    218212      end;
    219       with AddNewAction do begin
    220         Caption := 'Uložit';
    221         Action := 'Save';
    222       end;
     213      AddNewAction('Uložit', 'Save');
    223214    end;
    224215    if HandlerData.Request.Post.SearchKey('Save') <> -1 then

  • trunk/Modules/ZdechovNET/UAboutPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore, UUtils;
     30  UCore, UUtils, UWebSession;
    3131
    3232{ TAboutPage }

  • trunk/Modules/ZdechovNET/UContactPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore;
     30  UCore, UWebSession;
    3131
    3232procedure TContactPage.DataModuleProduce(HandlerData: THTTPHandlerData);

  • trunk/Modules/ZdechovNET/UDocumentsPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore, UUtils;
     30  UCore, UUtils, UWebSession;
    3131
    3232{ TDocumentsPage }

  • trunk/Modules/ZdechovNET/UHistoryPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore, UUtils;
     30  UCore, UUtils, UWebSession;
    3131
    3232{ THistoryPage }

  • trunk/Modules/ZdechovNET/UHostingPage.pas

    r98 r103  
    2929
    3030uses
    31   UCore;
     31  UCore, UWebSession;
    3232
    3333{ THostingPage }

  • trunk/Modules/ZdechovNET/ULinksPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore;
     30  UCore, UWebSession;
    3131
    3232{ TLinksPage }

  • trunk/Modules/ZdechovNET/UModuleZdechovNET.pas

    r98 r103  
    66
    77uses
    8   Classes, SysUtils, UModularSystem, SpecializedDictionary;
     8  Classes, SysUtils, UModularSystem, SpecializedDictionary, UWebPage,
     9  UWebSession, DateUtils;
    910
    1011type
    … …  
    1314
    1415  TModuleZdechovNET = class(TModule)
     16  private
     17    procedure Footer(Session: TWebSession);
     18    procedure GeneratePage(ASession: TWebSession; Page: TWebPage);
     19    procedure TopMenu(Session: TWebSession);
    1520  public
    1621    constructor Create(Owner: TComponent); override;
    … …  
    2934  UCore, USqlDatabase, UXmlClasses, UHtmlClasses, UUtils,
    3035  UInternetPage, UHostingPage, UHistoryPage, UDocumentsPage, UVoIPPage,
    31   ULinksPage, UPlansPage, UServerInfoPage, UWebCamPage,
     36  ULinksPage, UPlansPage, UServerInfoPage, UWebCamPage, UUser,
    3237  UNetworkPage, UAboutPage, UContactPage, UProjectsPage;
    3338
    … …  
    4247  License := 'GNU/LGPL v3';
    4348  Author := 'Chronosoft';
     49  Dependencies.Add('User');
    4450end;
    4551
    … …  
    98104    Data := TDictionaryStringString.Create;
    99105
     106    Core.GeneratePage := GeneratePage;
     107
    100108    Core.CommonDatabase.Query(DbRows,
    101109    'CREATE TABLE IF NOT EXISTS `VPSHosting` (' +
    … …  
    172180begin
    173181  inherited Uninstall;
     182  Core.GeneratePage := nil;
    174183  try
    175184    DbRows := TDbRows.Create;
    … …  
    189198end;
    190199
     200procedure TModuleZdechovNET.Footer(Session: TWebSession);
     201var
     202  Tag: TXMLTag;
     203  AdminTag: TXMLTag;
     204  EmailTag: TXMLTag;
     205  ExecutionTimeTag: TXMLTag;
     206  UsedMemoryTag: TXMLTag;
     207  TextNode: TXmlString;
     208begin
     209  with Session do
     210  with TXmlTag(HtmlDocument.Body.SubItems.AddNew(TXmlTag.Create)) do begin
     211    Name := 'ul';
     212    Attributes.Values['class'] := 'Footer';
     213    with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
     214      Name := 'li';
     215      with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
     216        Text := TCore(MainModule).Admin;
     217      end;
     218    end;
     219    with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
     220      Name := 'li';
     221      with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
     222        Text := TCore(MainModule).AdminEmail;
     223      end;
     224    end;
     225    if TCore(MainModule).ShowRuntimeInfo then begin
     226      with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
     227        Name := 'li';
     228        with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
     229          Text := 'Doba generování: ' +
     230            FloatToStr(Round(((Now - TimeStart) / OneMillisecond) * 100) / 100) + ' s / '; // + ini_get('max_execution_time') + ' s';
     231        end;
     232      end;
     233      with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
     234        Name := 'li';
     235        with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
     236          //Text := 'Použitá paměť: '  + System.PrefixMultiplier.AddPrefixMultipliers(memory_get_peak_usage(FALSE), 'B').' / '.ini_get('memory_limit').'B';
     237        end;
     238      end;
     239    end;
     240  end;
     241end;
     242
     243procedure TModuleZdechovNET.TopMenu(Session: TWebSession);
     244begin
     245  with Session, THtmlString(HtmlDocument.Body.SubItems.InsertNew(1, THtmlString.Create)) do begin
     246    Text := '<div class="Navigation">';
     247    // Visitor
     248    Text := Text + '<ul class="MenuItem">' +
     249      '<li>' + MakeLink('Úvod', NavigationLink('/')) + '</li>' +
     250      '<li>' + MakeLink('Internet', NavigationLink('/internet/')) + '</li>' +
     251      '<li>' + MakeLink('Hosting', NavigationLink('/hosting/')) + '</li>' +
     252      '<li>' + MakeLink('VoIP', NavigationLink('/voip/')) + '</li>' +
     253      '<li>' + MakeLink('Síť', NavigationLink('/sit/')) + '</li>' +
     254      '<li>' + MakeLink('Odkazy', NavigationLink('/odkazy/')) + '</li>' +
     255      '<li>' + MakeLink('Kontakt', NavigationLink('/kontakt/')) + '</li>' +
     256      '<li>' + MakeLink('Kamery', NavigationLink('/kamery/')) + '</li>' +
     257      '<li><a href="https://mail.zdechov.net/">Pošta</a></li>' +
     258      '<li><a href="http://wiki.zdechov.net/">Wiki</a></li>' +
     259      '</ul><ul class="MenuItem2">'; //<li>&nbsp;</li>';
     260    if Assigned(TCore(MainModule).Pages.FindByName('uzivatel')) then begin
     261      if UserOnline.User = UnknownUser then begin
     262        Text := Text + '</ul>' +
     263          '<ul class="MenuItem2">' +
     264          '<li>' + MakeLink('Přihlášení', NavigationLink('/uzivatel/prihlaseni/')) + '</li>' +
     265          '<li>' + MakeLink('Registrace', NavigationLink('/uzivatel/registrace/')) + '</li>' +
     266          '<li></li>';
     267        // $Output .= '<li>'.$this->System->HTML->MakeLink($this->System->Translate('UserRegistration'), $this->System->MakeLink('UserList', 'Register')).'</li>';
     268      end else begin
     269        Text := Text + '</ul>' +
     270          '<ul class="MenuItem2">' +
     271          '<li>' + User.FullName + '</li>' +
     272          '<li>' + MakeLink('Odhlášení', NavigationLink('/uzivatel/odhlaseni/')) + '</li>' +
     273          '<li>' + MakeLink('Profil', NavigationLink('/uzivatel/profil/')) + '</li>';
     274      end;
     275    end else Text := Text + '</ul><ul class="MenuItem2">&nbsp;';
     276    Text := Text + '</ul></div>';
     277  end;
     278end;
     279
     280procedure TModuleZdechovNET.GeneratePage(ASession: TWebSession; Page: TWebPage);
     281var
     282  I: Integer;
     283  TitleTag: THtmlString;
     284begin
     285  with ASession do begin
     286    HtmlDocument.ContentLanguage := 'cs';
     287    GlobalTitle := 'ZděchovNET';
     288    HtmlDocument.Styles.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Style.css'));
     289    HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/Global.js'));
     290    HtmlDocument.Scripts.Add(NavigationLink('/Style/' + TCore(MainModule).Style + '/jquery.js'));
     291
     292      TitleTag := THtmlString.Create;
     293      HtmlDocument.Body.SubItems.Insert(0, TitleTag);
     294      TopMenu(ASession);
     295      //Page.Page.OnProduce(HandlerData);
     296      HtmlDocument.Title := Page.Caption;
     297      TitleTag.Text := '<div class="TitlePanel"><span class="GlobalTitle">' + GlobalTitle +
     298        '</span> - ' + HtmlDocument.Title + '</div>';
     299      HtmlDocument.Title := GlobalTitle + ' - ' + HtmlDocument.Title;
     300      with HtmlDocument.AsXmlDocument do
     301      try
     302        Formated := TCore(MainModule).FormatHTML;
     303        Response.Content.WriteString(AsString);
     304      finally
     305        Free;
     306      end;
     307    end;
     308end;
     309
     310
    191311end.
    192312

  • trunk/Modules/ZdechovNET/UNetworkPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore, UUtils;
     30  UCore, UUtils, UWebSession;
    3131
    3232{ TNetworkPage }

  • trunk/Modules/ZdechovNET/UPlansPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore;
     30  UCore, UWebSession;
    3131
    3232{ TPlansPage }

  • trunk/Modules/ZdechovNET/UProjectsPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore;
     30  UCore, UWebSession;
    3131
    3232{ TProjectsPage }

  • trunk/Modules/ZdechovNET/UVoIPPage.pas

    r97 r103  
    2828
    2929uses
    30   UCore;
     30  UCore, UWebSession;
    3131
    3232{ TVoIPPage }

  • trunk/Modules/ZdechovNET/UWebCamPage.pas

    r100 r103  
    2828
    2929uses
    30   UCore, UUtils;
     30  UCore, UUtils, UWebSession;
    3131
    3232

  • trunk/Packages/CoolWeb/CoolWeb.lpk

    r96 r103  
    2727    <License Value="GNU/GPL"/>
    2828    <Version Minor="3"/>
    29     <Files Count="18">
     29    <Files Count="17">
    3030      <Item1>
    3131        <Filename Value="WebServer/UHTTPServer.pas"/>
    … …  
    7474      </Item10>
    7575      <Item11>
    76         <Filename Value="Modules/UUser.pas"/>
    77         <UnitName Value="UUser"/>
     76        <Filename Value="Common/UHtmlClasses.pas"/>
     77        <UnitName Value="UHtmlClasses"/>
    7878      </Item11>
    7979      <Item12>
    80         <Filename Value="Common/UHtmlClasses.pas"/>
    81         <UnitName Value="UHtmlClasses"/>
     80        <Filename Value="Common/UMemoryStreamEx.pas"/>
     81        <UnitName Value="UMemoryStreamEx"/>
    8282      </Item12>
    8383      <Item13>
    84         <Filename Value="Common/UMemoryStreamEx.pas"/>
    85         <UnitName Value="UMemoryStreamEx"/>
     84        <Filename Value="Common/UMIMEType.pas"/>
     85        <UnitName Value="UMIMEType"/>
    8686      </Item13>
    8787      <Item14>
    88         <Filename Value="Common/UMIMEType.pas"/>
    89         <UnitName Value="UMIMEType"/>
     88        <Filename Value="Common/UXmlClasses.pas"/>
     89        <UnitName Value="UXmlClasses"/>
    9090      </Item14>
    9191      <Item15>
    92         <Filename Value="Common/UXmlClasses.pas"/>
    93         <UnitName Value="UXmlClasses"/>
    94       </Item15>
    95       <Item16>
    9692        <Filename Value="WebServer/UWebPage.pas"/>
    9793        <HasRegisterProc Value="True"/>
    9894        <UnitName Value="UWebPage"/>
    99       </Item16>
    100       <Item17>
     95      </Item15>
     96      <Item16>
    10197        <Filename Value="WebServer/UWebApp.pas"/>
    10298        <HasRegisterProc Value="True"/>
    10399        <UnitName Value="UWebApp"/>
    104       </Item17>
    105       <Item18>
     100      </Item16>
     101      <Item17>
    106102        <Filename Value="LazIDEReg.pas"/>
    107103        <HasRegisterProc Value="True"/>
    108104        <UnitName Value="LazIDEReg"/>
    109       </Item18>
     105      </Item17>
    110106    </Files>
    111107    <Type Value="RunAndDesignTime"/>

  • trunk/Packages/CoolWeb/CoolWeb.pas

    r84 r103  
    1010  UHTTPServer, UHTTPServerCGI, UHTTPServerTCP, UHTTPServerTurboPower,
    1111  UTurboPowerForm, UHTTPSessionFile, UHTTPSessionMySQL, USqlDatabase,
    12   UTCPServer, UPageList, UUser, UHtmlClasses, UMemoryStreamEx, UMIMEType,
     12  UTCPServer, UPageList, UHtmlClasses, UMemoryStreamEx, UMIMEType,
    1313  UXmlClasses, UWebPage, UWebApp, LazIDEReg, LazarusPackageIntf;
    1414

  • trunk/Packages/CoolWeb/Modules/UUser.pas

    r100 r103  
    3131    function GetIdByNamePassword(Name: string; PassWord: string): Integer;
    3232    procedure Load;
     33    function CheckPermission(Module, Operation: string; ItemType: string = '';
     34      ItemId: Integer = 0): Boolean;
     35    function CheckGroupPermission(Group, Operation: Integer): Boolean;
    3336  end;
    3437
    … …  
    215218end;
    216219
     220function TWebUser.CheckPermission(Module, Operation: string;
     221  ItemType: string = ''; ItemId: Integer = 0): Boolean;
     222var
     223  DbRows: TDbRows;
     224  DbRows2: TDbRows;
     225  OperationId: Integer;
     226begin
     227  Result := False;
     228  try
     229    DbRows := TDbRows.Create;
     230    Database.Query(DbRows, 'SELECT `Id` FROM `PermissionOperation` WHERE `Module`="' + Module + '"' +
     231    ' AND `Operation` = "' + Operation + '" AND `Item` = "' + ItemType + '"' +
     232    ' AND `ItemId` = ' + IntToStr(ItemId));
     233    if DbRows.Count > 0 then
     234    try
     235      DbRows2 := TDbRows.Create;
     236      OperationId := StrToInt(DbRows[0].Values['Id']);
     237
     238      // Check user-operation relation
     239      Database.Select(DbRows2, 'PermissionUserAssignment', 'Id',
     240        '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(OperationId));
     241      if DbRows2.Count > 0 then begin
     242        Result := True;
     243        Exit;
     244      end;
     245
     246      // Check user-group relation
     247      Database.Select(DbRows2, 'PermissionUserAssignment', 'AssignedGroup',
     248        '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
     249      if DbRows2.Count > 0 then begin
     250        if CheckGroupPermission(StrToInt(DbRows2[0].Values['AssignedGroup']), OperationId) then begin
     251          Result := True;
     252          Exit;
     253        end;
     254      end;
     255    finally
     256      DbRows2.Free;
     257    end;
     258  finally
     259    DBRows.Free;
     260  end;
     261end;
     262
     263function TWebUser.CheckGroupPermission(Group, Operation: Integer): Boolean;
     264var
     265  DbRows2: TDbRows;
     266begin
     267  Result := False;
     268  try
     269      DbRows2 := TDbRows.Create;
     270
     271      // Check group-operation relation
     272      Database.Select(DbRows2, 'PermissionGroupAssignment', 'Id',
     273        '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(Operation));
     274      if DbRows2.Count > 0 then begin
     275        Result := True;
     276        Exit;
     277      end;
     278
     279      // Check group-group relation
     280      Database.Select(DbRows2, 'PermissionGroupAssignment', 'AssignedGroup',
     281        '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
     282      if DbRows2.Count > 0 then begin
     283        if CheckGroupPermission(StrToInt(DbRows2[0].Values['AssignedGroup']), Operation) then begin
     284          Result := True;
     285          Exit;
     286        end;
     287      end;
     288    finally
     289      DbRows2.Free;
     290    end;
     291end;
     292
    217293end.
    218294

  • trunk/Packages/CoolWeb/Persistence/USqlDatabase.pas

    r99 r103  
    5252    procedure SetConnected(const AValue: Boolean);
    5353    procedure SetDatabase(const Value: string);
     54    procedure SetEncoding(AValue: string);
    5455  public
    5556    LastUsedTable: string;
    … …  
    8485    property Password: string read FPassword write FPassword;
    8586    property Port: Word read FPort write FPort;
    86     property Encoding: string read FEncoding write FEncoding;
     87    property Encoding: string read FEncoding write SetEncoding;
    8788    property OnLogQuery: TLogEvent read FOnLogQuery write FOnLogQuery;
    8889  end;
    … …  
    198199  try
    199200    Rows := TDbRows.Create;
    200     Query(Rows, 'SET NAMES ' + Encoding);
     201    Query(Rows, 'SET NAMES ' + FEncoding);
    201202  finally
    202203    Rows.Free;
    … …  
    452453end;
    453454
     455procedure TSqlDatabase.SetEncoding(AValue: string);
     456var
     457  Rows: TDbRows;
     458begin
     459  if FEncoding = AValue then Exit;
     460  FEncoding := AValue;
     461  if Connected then begin
     462    try
     463      Rows := TDbRows.Create;
     464      Query(Rows, 'SET NAMES ' + FEncoding);
     465    finally
     466      Rows.Free;
     467    end;
     468  end;
     469end;
     470
    454471function TSqlDatabase.EscapeString(Text: string): string;
    455472var

  • trunk/Pages/UPageAdmin.pas

    r100 r103  
    3434uses
    3535  UCore, UXmlClasses, UHtmlClasses, UUtils, USqlDatabase, UModularSystem,
    36   UModuleSystem;
     36  UModuleSystem, UWebSession;
    3737
    3838{$R *.lfm}

  • trunk/Pages/UServerInfoPage.pas

    r81 r103  
    2828
    2929uses
    30   UCore;
     30  UCore, UWebSession;
    3131
    3232{ TServerInfoPage }
    … …  
    3737    LoadUserInfo;
    3838    Session.Values['Test'] := 'Tst';
    39     MainModule.WebApp1.HTTPServer.ServerInfo(HandlerData);
     39    TCore(MainModule).WebApp1.HTTPServer.ServerInfo(HandlerData);
    4040    GeneratePage(Self);
    4141  end;

  • trunk/UCore.pas

    r102 r103  
    1010  UXmlClasses, UHtmlClasses, UUtils, UApplicationInfo, UHTTPServerTCP,
    1111  UHTTPSessionFile, UUser, SpecializedList, Registry,
    12   UModularSystem;
     12  UModularSystem, UWebSession;
    1313
    1414const
    … …  
    2727    procedure WebApp1PageProduce(HandlerData: THTTPHandlerData);
    2828  private
     29    FGeneratePage: TGeneratePageEvent;
    2930    procedure Show(Content: string);
    3031    procedure RegisterModules;
    … …  
    5152    DatabasePassword: string;
    5253    DatabaseSchema: string;
     54    procedure GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
    5355    procedure LoadFromRegistry;
    5456    procedure SaveToRegistry;
    … …  
    5658    constructor Create(AOwner: TComponent); override;
    5759    destructor Destroy; override;
     60    property GeneratePage: TGeneratePageEvent read FGeneratePage write FGeneratePage;
    5861  end;
    5962
    … …  
    7376
    7477{ TCore }
     78
     79procedure TCore.GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
     80var
     81  I: Integer;
     82begin
     83  with ASession do begin
     84    HtmlDocument.ContentLanguage := 'cs';
     85    GlobalTitle := 'WebSystem';
     86
     87      //Page.Page.OnProduce(HandlerData);
     88      HtmlDocument.Title := Page.Caption;
     89      with HtmlDocument.AsXmlDocument do
     90      try
     91        Formated := TCore(MainModule).FormatHTML;
     92        Response.Content.WriteString(AsString);
     93      finally
     94        Free;
     95      end;
     96    end;
     97end;
    7598
    7699constructor TCore.Create(AOwner: TComponent);
    … …  
    102125  FreeAndNil(Pages);
    103126  inherited;
    104 end;
    105 
    106 procedure TWebSession.Footer;
    107 var
    108   Tag: TXMLTag;
    109   AdminTag: TXMLTag;
    110   EmailTag: TXMLTag;
    111   ExecutionTimeTag: TXMLTag;
    112   UsedMemoryTag: TXMLTag;
    113   TextNode: TXmlString;
    114 begin
    115   with TXmlTag(HtmlDocument.Body.SubItems.AddNew(TXmlTag.Create)) do begin
    116     Name := 'ul';
    117     Attributes.Values['class'] := 'Footer';
    118     with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
    119       Name := 'li';
    120       with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
    121         Text := MainModule.Admin;
    122       end;
    123     end;
    124     with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
    125       Name := 'li';
    126       with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
    127         Text := MainModule.AdminEmail;
    128       end;
    129     end;
    130     if MainModule.ShowRuntimeInfo then begin
    131       with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
    132         Name := 'li';
    133         with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
    134           Text := 'Doba generování: ' +
    135             FloatToStr(Round(((Now - TimeStart) / OneMillisecond) * 100) / 100) + ' s / '; // + ini_get('max_execution_time') + ' s';
    136         end;
    137       end;
    138       with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
    139         Name := 'li';
    140         with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
    141           //Text := 'Použitá paměť: '  + System.PrefixMultiplier.AddPrefixMultipliers(memory_get_peak_usage(FALSE), 'B').' / '.ini_get('memory_limit').'B';
    142         end;
    143       end;
    144     end;
    145   end;
    146127end;
    147128
    … …  
    202183  finally
    203184    DbRows.Free;
    204   end;
    205 end;
    206 
    207 procedure TWebSession.TopMenu;
    208 begin
    209   with THtmlString(HtmlDocument.Body.SubItems.InsertNew(1, THtmlString.Create)) do begin
    210     Text := '<div class="Navigation">';
    211     // Visitor
    212     Text := Text + '<ul class="MenuItem">' +
    213       '<li>' + MakeLink('Úvod', NavigationLink('/')) + '</li>' +
    214       '<li>' + MakeLink('Internet', NavigationLink('/internet/')) + '</li>' +
    215       '<li>' + MakeLink('Hosting', NavigationLink('/hosting/')) + '</li>' +
    216       '<li>' + MakeLink('VoIP', NavigationLink('/voip/')) + '</li>' +
    217       '<li>' + MakeLink('Síť', NavigationLink('/sit/')) + '</li>' +
    218       '<li>' + MakeLink('Odkazy', NavigationLink('/odkazy/')) + '</li>' +
    219       '<li>' + MakeLink('Kontakt', NavigationLink('/kontakt/')) + '</li>' +
    220       '<li>' + MakeLink('Kamery', NavigationLink('/kamery/')) + '</li>' +
    221       '<li><a href="https://mail.zdechov.net/">Pošta</a></li>' +
    222       '<li><a href="http://wiki.zdechov.net/">Wiki</a></li>' +
    223       '</ul><ul class="MenuItem2">'; //<li>&nbsp;</li>';
    224     if Assigned(MainModule.Pages.FindByName('uzivatel')) then begin
    225       if UserOnline.User = AnonymousUserId then begin
    226         Text := Text + '</ul>' +
    227           '<ul class="MenuItem2">' +
    228           '<li>' + MakeLink('Přihlášení', NavigationLink('/uzivatel/prihlaseni/')) + '</li>' +
    229           '<li>' + MakeLink('Registrace', NavigationLink('/uzivatel/registrace/')) + '</li>' +
    230           '<li></li>';
    231         // $Output .= '<li>'.$this->System->HTML->MakeLink($this->System->Translate('UserRegistration'), $this->System->MakeLink('UserList', 'Register')).'</li>';
    232       end else begin
    233         Text := Text + '</ul>' +
    234           '<ul class="MenuItem2">' +
    235           '<li>' + User.FullName + '</li>' +
    236           '<li>' + MakeLink('Odhlášení', NavigationLink('/uzivatel/odhlaseni/')) + '</li>' +
    237           '<li>' + MakeLink('Profil', NavigationLink('/uzivatel/profil/')) + '</li>';
    238       end;
    239     end else Text := Text + '</ul><ul class="MenuItem2">&nbsp;';
    240     Text := Text + '</ul></div>';
    241185  end;
    242186end;
    … …  
    281225          THTMLString(TWebSession(NewSession).HtmlDocument.Body.SubItems.AddNew(THtmlString.Create)).
    282226            Text := Format(SError, [E.Message]);
    283           NewSession.GeneratePage(Page.Page);
     227          if Assigned(GeneratePage) then GeneratePage(NewSession, Page.Page)
     228            else GeneratePageDefault(NewSession, Page.Page);
    284229        end;
    285230      end;

  • trunk/ZdechovNET.lpi

    r102 r103  
    117117      </Item7>
    118118    </RequiredPackages>
    119     <Units Count="34">
     119    <Units Count="35">
    120120      <Unit0>
    121121        <Filename Value="ZdechovNET.lpr"/>
    … …  
    187187        <IsPartOfProject Value="True"/>
    188188        <HasResources Value="True"/>
     189        <UnitName Value="UAboutPage"/>
    189190      </Unit11>
    190191      <Unit12>
    … …  
    192193        <IsPartOfProject Value="True"/>
    193194        <HasResources Value="True"/>
     195        <UnitName Value="UContactPage"/>
    194196      </Unit12>
    195197      <Unit13>
    … …  
    197199        <IsPartOfProject Value="True"/>
    198200        <HasResources Value="True"/>
     201        <UnitName Value="UDocumentsPage"/>
    199202      </Unit13>
    200203      <Unit14>
    … …  
    220223        <IsPartOfProject Value="True"/>
    221224        <HasResources Value="True"/>
     225        <UnitName Value="ULinksPage"/>
    222226      </Unit17>
    223227      <Unit18>
    … …  
    225229        <IsPartOfProject Value="True"/>
    226230        <HasResources Value="True"/>
     231        <UnitName Value="UNetworkPage"/>
    227232      </Unit18>
    228233      <Unit19>
    … …  
    230235        <IsPartOfProject Value="True"/>
    231236        <HasResources Value="True"/>
     237        <UnitName Value="UPlansPage"/>
    232238      </Unit19>
    233239      <Unit20>
    … …  
    235241        <IsPartOfProject Value="True"/>
    236242        <HasResources Value="True"/>
     243        <UnitName Value="UProjectsPage"/>
    237244      </Unit20>
    238245      <Unit21>
    … …  
    240247        <IsPartOfProject Value="True"/>
    241248        <HasResources Value="True"/>
     249        <UnitName Value="UVoIPPage"/>
    242250      </Unit21>
    243251      <Unit22>
    … …  
    299307        <IsPartOfProject Value="True"/>
    300308        <ComponentName Value="WebPagePortal"/>
     309        <HasResources Value="True"/>
    301310        <ResourceBaseClass Value="DataModule"/>
    302311        <UnitName Value="UPagePortal"/>
    … …  
    312321        <UnitName Value="UWebSession"/>
    313322      </Unit33>
     323      <Unit34>
     324        <Filename Value="Modules/User/UUser.pas"/>
     325        <IsPartOfProject Value="True"/>
     326        <UnitName Value="UUser"/>
     327      </Unit34>
    314328    </Units>
    315329  </ProjectOptions>

  • trunk/languages/index.cs.po

    r98 r103  
    9999msgstr "Chyba požadavku databáze: \"%s\""
    100100
     101#: uuser.scannotuseanonymous
     102msgid "Cannot use anonymous user"
     103msgstr ""
     104
    101105#: uuser.sduplicateuseritem
    102 msgid "User name already used."
     106#, fuzzy
     107#| msgid "User name already used."
     108msgid "User name \"%s\" already used."
    103109msgstr "Uživatelské jméno již použito."
    104110
     111#: uuser.semptyuserparameters
     112msgid "Missing user parameters"
     113msgstr ""
     114
     115#: uuser.susernotfound
     116msgid "User \"%s\" not found"
     117msgstr ""
     118

  • trunk/languages/index.po

    r98 r103  
    9191msgstr ""
    9292
    93 #: uuser.sduplicateuseritem
    94 msgid "User name already used."
     93#: uuser.scannotuseanonymous
     94msgid "Cannot use anonymous user"
    9595msgstr ""
    9696
     97#: uuser.sduplicateuseritem
     98msgid "User name \"%s\" already used."
     99msgstr ""
     100
     101#: uuser.semptyuserparameters
     102msgid "Missing user parameters"
     103msgstr ""
     104
     105#: uuser.susernotfound
     106msgid "User \"%s\" not found"
     107msgstr ""
     108
Note: See TracChangeset for help on using the changeset viewer.