Changeset 54 for trunk/Modules

Timestamp:

Jul 20, 2011, 11:52:31 PM (13 years ago)

Author:

george

Message:

• Upraveno: Přesunuty další části z UMainModule do třídy UWebApp valíku CoolWeb.

Location:

trunk/Modules

Files:

• UMainModule.lfm (modified) (1 diff)
• UMainModule.lrs (modified) (1 diff)
• UMainModule.pas (modified) (10 diffs)

trunk/Modules/UMainModule.lfm

@@ -5 +5 @@
   VerticalOffset = 205
   Width = 431
-  object HTTPServer: THTTPServerCGI
-    ShowExceptions = False
-    DocumentRoot = './'
-    SessionStorage = HTTPSessionStorageMySQL1
-    OnRequest = HTTPServerRequest
-    left = 81
-    top = 32
-  end
   object HTTPSessionStorageMySQL1: THTTPSessionStorageMySQL
     Database = Database

trunk/Modules/UMainModule.lrs

@@ -3 +3 @@
 LazarusResources.Add('TMainModule','FORMDATA',[
   'TPF0'#11'TMainModule'#10'MainModule'#14'OldCreateOrder'#8#6'Height'#3#22#1#16
-  +'HorizontalOffset'#3#162#1#14'VerticalOffset'#3#205#0#5'Width'#3#175#1#0#14
-  +'THTTPServerCGI'#10'HTTPServer'#14'ShowExceptions'#8#12'DocumentRoot'#6#2'./'
-  +#14'SessionStorage'#7#24'HTTPSessionStorageMySQL1'#9'OnRequest'#7#17'HTTPSer'
-  +'verRequest'#4'left'#2'Q'#3'top'#2' '#0#0#24'THTTPSessionStorageMySQL'#24'HT'
-  +'TPSessionStorageMySQL1'#8'Database'#7#8'Database'#7'Timeout'#3'0*'#19'Sessi'
-  +'onIdCookieName'#6#9'SessionId'#4'left'#3'8'#1#3'top'#2#31#0#0#12'TSqlDataba'
-  +'se'#8'Database'#9'Connected'#8#8'Encoding'#6#4'utf8'#4'left'#2'Q'#3'top'#2
-  +'V'#0#0#0
+  +'HorizontalOffset'#3#162#1#14'VerticalOffset'#3#205#0#5'Width'#3#175#1#0#24
+  +'THTTPSessionStorageMySQL'#24'HTTPSessionStorageMySQL1'#8'Database'#7#8'Data'
+  +'base'#7'Timeout'#3'0*'#19'SessionIdCookieName'#6#9'SessionId'#4'left'#3'8'#1
+  +#3'top'#2#31#0#0#12'TSqlDatabase'#8'Database'#9'Connected'#8#8'Encoding'#6#4
+  +'utf8'#4'left'#2'Q'#3'top'#2'V'#0#0#0
 ]);

trunk/Modules/UMainModule.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, LResources, UHTTPServerCGI, UHTTPSessionMySQL,
-  UHTTPServer, USqlDatabase, UConfig, DateUtils, UWebPage,
+  UHTTPServer, USqlDatabase, UConfig, DateUtils, UWebPage, UWebApp,
   UXmlClasses, UHtmlClasses, UCore, UHTTPServerTCP,
   UHTTPSessionFile, UUser, SpecializedList;
 
 type
-  TMainModule = class;
-
-  TRegistredPage = class
-    Name: string;
-    Page: TWebPage;
-  end;
-
-  { TRegistredPageList }
-
-  TRegistredPageList = class(TListObject)
-    function FindByName(Name: string): TRegistredPage;
-  end;
-
   { TMainModule }
 
   TMainModule = class(TDataModule)
-    HTTPServer: THTTPServerCGI;
     HTTPSessionStorageMySQL1: THTTPSessionStorageMySQL;
     Database: TSqlDatabase;
-    procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
   private
     procedure Footer;
@@ -49 +34 @@
     Keywords: string;
     HtmlDocument: THtmlDocument;
-    Pages: TRegistredPageList;
     PageName: string;
     ModuleName: string;
@@ -55 +39 @@
     User: TWebUser;
     UserOnline: TWebOnlineUser;
+    procedure GeneratePage(HandlerData: THTTPHandlerData; Page: TWebPage);
     procedure Run;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    procedure RegisterPage(Name: string; Page: TWebPage);
   end;
 
@@ -64 +48 @@
   MainModule: TMainModule;
 
- resourcestring
-  SPageNotFound = 'Page not found';
-
 
 implementation
 
-{ TRegistredPageList }
-
-function TRegistredPageList.FindByName(Name: string): TRegistredPage;
-var
-  I: Integer;
-begin
-  I := 0;
-  while (I < Count) and (TRegistredPage(Items[I]).Name <> Name) do Inc(I);
-  if I < Count then Result := TRegistredPage(Items[I])
-    else Result := nil;
-end;
-
 { TMainModule }
 
-procedure TMainModule.HTTPServerRequest(HandlerData: THTTPHandlerData);
+procedure TMainModule.GeneratePage(HandlerData: THTTPHandlerData; Page: TWebPage);
 var
   I: Integer;
   TitleTag: THtmlString;
-  Page: TRegistredPage;
 begin
   User.HandlerData := HandlerData;
@@ -103 +71 @@
     HtmlDocument.Scripts.Add(NavigationLink('/Style/' + Style + '/jquery.js'));
 
-    Request.QueryParts.Count := 2;
-    Request.QueryParts[0] := 'uzivatel';
-    Request.QueryParts[1] := 'prihlaseni';
-
-    if Request.QueryParts.Count > 0 then PageName := Request.QueryParts[0]
-      else PageName := '';
-    Page := Pages.FindByName(PageName);
-    if Assigned(Page) then begin
       TitleTag := THtmlString.Create;
-      HtmlDocument.Body.SubItems.Add(TitleTag);
+      HtmlDocument.Body.SubItems.Insert(0, TitleTag);
       TopMenu;
-      Page.Page.OnProduce(HandlerData);
-      HtmlDocument.Title := Page.Page.Caption;
+      //Page.Page.OnProduce(HandlerData);
+      HtmlDocument.Title := Page.Caption;
       TitleTag.Text := '<div class="TitlePanel"><span class="GlobalTitle">' + GlobalTitle +
         '</span> - ' + HtmlDocument.Title + '</div>';
@@ -126 +86 @@
         Free;
       end;
-    end else Response.Stream.WriteString(SPageNotFound);
-  end;
-end;
-
-procedure TMainModule.RegisterPage(Name: string; Page: TWebPage);
-var
-  NewRegistredPage: TRegistredPage;
-begin
-  NewRegistredPage := TRegistredPage.Create;
-  NewRegistredPage.Name := Name;
-  NewRegistredPage.Page := Page;
-  Pages.Add(NewRegistredPage);
-end;
-
+  end;
+end;
 
 procedure TMainModule.InitDatabase;
@@ -163 +111 @@
 begin
   inherited;
-  Pages := TRegistredPageList.Create;
   HtmlDocument := THtmlDocument.Create;
   User := TWebUser.Create;
@@ -174 +121 @@
 begin
   HtmlDocument.Free;
-  Pages.Free;
   User.Free;
   UserOnline.Free;
@@ -251 +197 @@
 procedure TMainModule.TopMenu;
 begin
-  with THtmlString(HtmlDocument.Body.SubItems.AddNew(THtmlString.Create)) do begin
+  with THtmlString(HtmlDocument.Body.SubItems.InsertNew(1, THtmlString.Create)) do begin
     Text := '<div class="Navigation">';
     // Visitor
@@ -286 +232 @@
 begin
   InitDatabase;
-  MainModule.HTTPServer.ShowExceptions := Config.ShowException;
+  Application.HTTPServer.ShowExceptions := Config.ShowException;
   //Database.Query('SELECT * FROM ssss');
-  MainModule.HTTPServer.Run;
 end;