Changeset 103 for trunk/Application

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/Application

Files:

• UWebObjects.pas (modified) (2 diffs)
• UWebSession.pas (modified) (7 diffs)

trunk/Application/UWebObjects.pas

@@ -67 +67 @@
     ClassId: string;
     function AddNewGroup: TQueryFormGroup;
-    function AddNewAction: TQueryAction;
+    function AddNewAction(Caption, Action: string): TQueryAction;
     procedure Load(Items: TDictionaryStringString);
     constructor Create;
@@ -192 +192 @@
 end;
 
-function TQueryForm.AddNewAction: TQueryAction;
+function TQueryForm.AddNewAction(Caption, Action: string): TQueryAction;
 begin
   Result := TQueryAction(Actions.AddNew(TQueryAction.Create));
+  Result.Caption := Caption;
+  Result.Action := Action;
 end;
 

trunk/Application/UWebSession.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, UHTTPServer, USqlDatabase, UHTTPSessionMySQL, UUser,
-  UHtmlClasses, UWebPage;
+  UHtmlClasses, UWebPage, UUtils, UXmlClasses, DateUtils;
 
 type
@@ -14 +14 @@
   TWebSession = class(THTTPHandlerData)
   private
-    procedure TopMenu;
-    procedure Footer;
   public
     MainModule: TObject;
@@ -27 +25 @@
     procedure LoadUserInfo;
     procedure InitDatabase;
-    procedure GeneratePage(Page: TWebPage);
     constructor Create; override;
     destructor Destroy; override;
+    procedure GeneratePage(Page: TWebPage);
   end;
 
+  TGeneratePageEvent = procedure (Session: TWebSession; Page: TWebPage) of object;
 
 implementation
+
+uses
+  UCore;
 
 { TWebSession }
@@ -60 +62 @@
 end;
 
+procedure TWebSession.GeneratePage(Page: TWebPage);
+begin
+  with TCore(MainModule) do
+  if Assigned(GeneratePage) then GeneratePage(Self, Page)
+    else GeneratePageDefault(Self, Page);
+end;
+
 procedure TWebSession.InitDatabase;
 var
@@ -65 +74 @@
 begin
   with Database do begin
+    Encoding := 'utf8';
     Connect;
-  end;
-  try
-    DbRows := TDbRows.Create;
-    Database.Query(DbRows, 'SET NAMES utf8');
-  finally
-    DbRows.Free;
   end;
 end;
@@ -77 +81 @@
 procedure TWebSession.LoadUserInfo;
 begin
-  if MainModule.ModuleManager.ModuleRunning('User') then begin
+  if TCore(MainModule).ModuleManager.ModuleRunning('User') then begin
     User.HandlerData := Self;
     UserOnline.HandlerData := Self;
@@ -86 +90 @@
 end;
 
-procedure TWebSession.GeneratePage(Page: TWebPage);
-var
-  I: Integer;
-  TitleTag: THtmlString;
-begin
-    HtmlDocument.ContentLanguage := 'cs';
-    GlobalTitle := 'ZděchovNET';
-    HtmlDocument.Styles.Add(NavigationLink('/Style/' + MainModule.Style + '/Style.css'));
-    HtmlDocument.Scripts.Add(NavigationLink('/Style/' + MainModule.Style + '/Global.js'));
-    HtmlDocument.Scripts.Add(NavigationLink('/Style/' + MainModule.Style + '/jquery.js'));
-
-      TitleTag := THtmlString.Create;
-      HtmlDocument.Body.SubItems.Insert(0, TitleTag);
-      TopMenu;
-      //Page.Page.OnProduce(HandlerData);
-      HtmlDocument.Title := Page.Caption;
-      TitleTag.Text := '<div class="TitlePanel"><span class="GlobalTitle">' + GlobalTitle +
-        '</span> - ' + HtmlDocument.Title + '</div>';
-      HtmlDocument.Title := GlobalTitle + ' - ' + HtmlDocument.Title;
-      with HtmlDocument.AsXmlDocument do
-      try
-        Formated := MainModule.FormatHTML;
-        Response.Content.WriteString(AsString);
-      finally
-        Free;
-      end;
-end;
-
 end.