Changeset 105 for trunk/UCore.pas

Timestamp:

Oct 9, 2012, 1:58:45 PM (12 years ago)

Author:

chronos

Message:

• Přidáno: Hlavní modul Base, který slouží jako základní rozhraní k aplikaci pro ostatní moduly. Modul System zajistí udržování seznamu instalovaných modulů v perzistentním úložišti v databázi.
• Upraveno: Správce modulů ModuleManager je nyní použit pro každé komunikační spojení zvlášť.

File:

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

trunk/UCore.pas

@@ -17 +17 @@
 
 type
-  TCore = class;
-
-
   { TCore }
 
@@ -27 +24 @@
     procedure WebApp1PageProduce(HandlerData: THTTPHandlerData);
   private
-    FGeneratePage: TGeneratePageEvent;
     procedure Show(Content: string);
-    procedure RegisterModules;
-    procedure CheckModules;
   public
     CommonDatabase: TSqlDatabase;
-    ModuleManager: TModuleManager;
     Load: string;
     Unload: string;
@@ -47 +40 @@
     NetworkPort: Integer;
     MaxConnections: Integer;
-    Pages: TPageList;
     DatabaseHostname: string;
     DatabaseUserName: string;
     DatabasePassword: string;
     DatabaseSchema: string;
-    procedure GeneratePageDefault(ASession: TWebSession; Page: TWebPage);
     procedure LoadFromRegistry;
     procedure SaveToRegistry;
@@ -58 +49 @@
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    property GeneratePage: TGeneratePageEvent read FGeneratePage write FGeneratePage;
   end;
 
@@ -67 +57 @@
 implementation
 
-uses
-  UModuleSystem, UModuleZdechovNET, UModuleUser, UPageAdmin, UModuleTV,
-  UModuleFinance, UModuleNetwork, UModulePortal, UModuleIS;
-
-resourcestring
-  SError = '<div>Error: %s</div>';
-
 
 { 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);
 begin
   inherited;
-  ModuleManager := TModuleManager.Create(nil);
-  Pages := TPageList.Create;
   CommonDatabase := TSqlDatabase.Create(nil);
 
   LoadFromRegistry;
-  with Pages do begin
-    RegisterPage(TPageAdmin, PageAdmin, 'administration');
-  end;
   with WebApp1 do begin
     if ServerType = stTCP then begin
@@ -121 +79 @@
   //SaveToRegistry;
   FreeAndNil(CommonDatabase);
-  ModuleManager.StopAll;
-  FreeAndNil(ModuleManager);
-  FreeAndNil(Pages);
   inherited;
 end;
@@ -154 +109 @@
 end;
 
-procedure TCore.RegisterModules;
-begin
-  with ModuleManager do begin
-    RegisterModule(TModuleSystem.Create(nil), True);
-    RegisterModule(TModuleUser.Create(nil), True);
-    RegisterModule(TModuleZdechovNET.Create(nil), True);
-    RegisterModule(TModuleTV.Create(nil), True);
-    RegisterModule(TModuleFinance.Create(nil), True);
-    RegisterModule(TModuleNetwork.Create(nil), True);
-    RegisterModule(TModulePortal.Create(nil), True);
-    RegisterModule(TModuleIS.Create(nil), True);
-  end;
-end;
-
-procedure TCore.CheckModules;
-var
-  DbRows: TDbRows;
-  Module: TModule;
-  I: Integer;
-begin
-  try
-    DbRows := TDbRows.Create;
-    CommonDatabase.Query(DbRows, 'SELECT * FROM INFORMATION_SCHEMA.TABLES ' +
-      'WHERE TABLE_SCHEMA = "' + CommonDatabase.Database + '" AND TABLE_NAME = "SystemModule"');
-    Module := ModuleManager.FindModuleByName('System');
-    if DbRows.Count > 0 then Module.SetInstalledState(True)
-      else Module.SetInstalledState(False);
-  finally
-    DbRows.Free;
-  end;
-end;
-
 procedure TCore.WebApp1PageProduce(HandlerData: THTTPHandlerData);
 var
-  FileName: string;
-  PageName: string;
-  Page: TRegistredPage;
   NewSession: TWebSession;
-  BaseUrlParts: TListString;
 begin
-  with HandlerData do begin
-    try
-      BaseUrlParts := TListString.Create;
-      BaseUrlParts.Explode(BaseURL, '/', StrToStr);
-      while (BaseUrlParts.Count > 0) and (Request.Path.Count > 0) and
-         (BaseUrlParts[0] = Request.Path[0]) do begin
-           BaseUrlParts.Delete(0);
-           Request.Path.Delete(0);
-         end;
-    finally
-      BaseUrlParts.Free;
-    end;
-    if Request.Path.Count > 0 then PageName := Request.Path[0]
-      else PageName := '';
-    Page := Pages.FindByName(PageName);
-    if Assigned(Page) then begin
-      NewSession := TWebSession.Create;
-      NewSession.MainModule := Self;
-      NewSession.Assign(HandlerData);
-      NewSession.TimeStart := Now;
-      NewSession.Database.HostName := DatabaseHostName;
-      NewSession.Database.Password := DatabasePassword;
-      NewSession.Database.Database := DatabaseSchema;
-      NewSession.Database.UserName := DatabaseUserName;
-      NewSession.InitDatabase;
-      try
-        Page.Page.OnProduce(NewSession);
-      except
-        on E: Exception do begin
-          THTMLString(TWebSession(NewSession).HtmlDocument.Body.SubItems.AddNew(THtmlString.Create)).
-            Text := Format(SError, [E.Message]);
-          if Assigned(GeneratePage) then GeneratePage(NewSession, Page.Page)
-            else GeneratePageDefault(NewSession, Page.Page);
-        end;
-      end;
-      HandlerData.Assign(NewSession);
-    end else begin
-      WebApp1.HTTPServer.FileResponse(HandlerData)
-    end;
-  end;
+  NewSession := TWebSession.Create;
+  NewSession.MainModule := Self;
+  NewSession.Assign(HandlerData);
+  NewSession.TimeStart := Now;
+  NewSession.Database.HostName := DatabaseHostName;
+  NewSession.Database.Password := DatabasePassword;
+  NewSession.Database.Database := DatabaseSchema;
+  NewSession.Database.UserName := DatabaseUserName;
+  NewSession.InitDatabase;
+  NewSession.BaseURL := BaseURL;
+  NewSession.Run;
+  HandlerData.Assign(NewSession);
 end;
 
@@ -296 +187 @@
   CommonDatabase.Connect;
 
-  RegisterModules;
-  CheckModules;
-  ModuleManager.StartInstalled;
-
   WebApp1.HTTPServer.DocumentRoot := ExtractFileDir(ParamStrUTF8(0));
   WebApp1.Run;