Changeset 103 for trunk/UCore.pas

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.

File:

• trunk/UCore.pas (modified) (8 diffs)

trunk/UCore.pas

@@ -10 +10 @@
   UXmlClasses, UHtmlClasses, UUtils, UApplicationInfo, UHTTPServerTCP,
   UHTTPSessionFile, UUser, SpecializedList, Registry,
-  UModularSystem;
+  UModularSystem, UWebSession;
 
 const
@@ -27 +27 @@
     procedure WebApp1PageProduce(HandlerData: THTTPHandlerData);
   private
+    FGeneratePage: TGeneratePageEvent;
     procedure Show(Content: string);
     procedure RegisterModules;
@@ -51 +52 @@
     DatabasePassword: string;
     DatabaseSchema: string;
+    procedure GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
     procedure LoadFromRegistry;
     procedure SaveToRegistry;
@@ -56 +58 @@
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    property GeneratePage: TGeneratePageEvent read FGeneratePage write FGeneratePage;
   end;
 
@@ -73 +76 @@
 
 { TCore }
+
+procedure TCore.GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
+var
+  I: Integer;
+begin
+  with ASession do begin
+    HtmlDocument.ContentLanguage := 'cs';
+    GlobalTitle := 'WebSystem';
+
+      //Page.Page.OnProduce(HandlerData);
+      HtmlDocument.Title := Page.Caption;
+      with HtmlDocument.AsXmlDocument do
+      try
+        Formated := TCore(MainModule).FormatHTML;
+        Response.Content.WriteString(AsString);
+      finally
+        Free;
+      end;
+    end;
+end;
 
 constructor TCore.Create(AOwner: TComponent);
@@ -102 +125 @@
   FreeAndNil(Pages);
   inherited;
-end;
-
-procedure TWebSession.Footer;
-var
-  Tag: TXMLTag;
-  AdminTag: TXMLTag;
-  EmailTag: TXMLTag;
-  ExecutionTimeTag: TXMLTag;
-  UsedMemoryTag: TXMLTag;
-  TextNode: TXmlString;
-begin
-  with TXmlTag(HtmlDocument.Body.SubItems.AddNew(TXmlTag.Create)) do begin
-    Name := 'ul';
-    Attributes.Values['class'] := 'Footer';
-    with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
-      Name := 'li';
-      with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
-        Text := MainModule.Admin;
-      end;
-    end;
-    with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
-      Name := 'li';
-      with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
-        Text := MainModule.AdminEmail;
-      end;
-    end;
-    if MainModule.ShowRuntimeInfo then begin
-      with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
-        Name := 'li';
-        with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
-          Text := 'Doba generování: ' +
-            FloatToStr(Round(((Now - TimeStart) / OneMillisecond) * 100) / 100) + ' s / '; // + ini_get('max_execution_time') + ' s';
-        end;
-      end;
-      with TXmlTag(SubElements.AddNew(TXmlTag.Create)) do begin
-        Name := 'li';
-        with TXmlString(SubElements.AddNew(TXmlString.Create)) do begin
-          //Text := 'Použitá paměť: '  + System.PrefixMultiplier.AddPrefixMultipliers(memory_get_peak_usage(FALSE), 'B').' / '.ini_get('memory_limit').'B';
-        end;
-      end;
-    end;
-  end;
 end;
 
@@ -202 +183 @@
   finally
     DbRows.Free;
-  end;
-end;
-
-procedure TWebSession.TopMenu;
-begin
-  with THtmlString(HtmlDocument.Body.SubItems.InsertNew(1, THtmlString.Create)) do begin
-    Text := '<div class="Navigation">';
-    // Visitor
-    Text := Text + '<ul class="MenuItem">' +
-      '<li>' + MakeLink('Úvod', NavigationLink('/')) + '</li>' +
-      '<li>' + MakeLink('Internet', NavigationLink('/internet/')) + '</li>' +
-      '<li>' + MakeLink('Hosting', NavigationLink('/hosting/')) + '</li>' +
-      '<li>' + MakeLink('VoIP', NavigationLink('/voip/')) + '</li>' +
-      '<li>' + MakeLink('Síť', NavigationLink('/sit/')) + '</li>' +
-      '<li>' + MakeLink('Odkazy', NavigationLink('/odkazy/')) + '</li>' +
-      '<li>' + MakeLink('Kontakt', NavigationLink('/kontakt/')) + '</li>' +
-      '<li>' + MakeLink('Kamery', NavigationLink('/kamery/')) + '</li>' +
-      '<li><a href="https://mail.zdechov.net/">Pošta</a></li>' +
-      '<li><a href="http://wiki.zdechov.net/">Wiki</a></li>' +
-      '</ul><ul class="MenuItem2">'; //<li>&nbsp;</li>';
-    if Assigned(MainModule.Pages.FindByName('uzivatel')) then begin
-      if UserOnline.User = AnonymousUserId then begin
-        Text := Text + '</ul>' +
-          '<ul class="MenuItem2">' +
-          '<li>' + MakeLink('Přihlášení', NavigationLink('/uzivatel/prihlaseni/')) + '</li>' +
-          '<li>' + MakeLink('Registrace', NavigationLink('/uzivatel/registrace/')) + '</li>' +
-          '<li></li>';
-        // $Output .= '<li>'.$this->System->HTML->MakeLink($this->System->Translate('UserRegistration'), $this->System->MakeLink('UserList', 'Register')).'</li>';
-      end else begin
-        Text := Text + '</ul>' +
-          '<ul class="MenuItem2">' +
-          '<li>' + User.FullName + '</li>' +
-          '<li>' + MakeLink('Odhlášení', NavigationLink('/uzivatel/odhlaseni/')) + '</li>' +
-          '<li>' + MakeLink('Profil', NavigationLink('/uzivatel/profil/')) + '</li>';
-      end;
-    end else Text := Text + '</ul><ul class="MenuItem2">&nbsp;';
-    Text := Text + '</ul></div>';
   end;
 end;
@@ -281 +225 @@
           THTMLString(TWebSession(NewSession).HtmlDocument.Body.SubItems.AddNew(THtmlString.Create)).
             Text := Format(SError, [E.Message]);
-          NewSession.GeneratePage(Page.Page);
+          if Assigned(GeneratePage) then GeneratePage(NewSession, Page.Page)
+            else GeneratePageDefault(NewSession, Page.Page);
         end;
       end;