Changeset 88 for branches/DirectWeb/UWebServer.pas

Timestamp:

Dec 18, 2009, 12:21:39 PM (14 years ago)

Author:

george

Message:

• Upraveno: Nedokončené přepracování správy vláken. Použit systém přidělování ze společné sady o dané velikosti namísto přidělování vláken ke každému požadavku samostatně. Vlákna jsou inicializována při spuštění aplikace, jsou opakovaně používána a uvolněna až při ukončení běhu aplikace.
• Přidáno: Třída pro práci s opakovaně spustitelnými vlákny.
• Přidáno: Třída přidělování objektů ze zásoby o dané velikosti.
• Přidáno: Třída pro zobrazování stránkování seznamů položek.

File:

• branches/DirectWeb/UWebServer.pas (modified) (13 diffs)

branches/DirectWeb/UWebServer.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, UHTTPServer, UHTTPSessionFile,
-  UTCPServer,
-  UCommon,
+  UTCPServer, Contnrs,
+  UCommon, syncobjs,
   UMemoryStreamEx,
   UMIMEType, Synautil,
-  USqlDatabase, DOM, XMLRead;
+  USqlDatabase, DOM, XMLRead, UHTMLControls;
 
 const
@@ -17 +17 @@
 
 type
-  { TWebServer }
-
-  TWebServer = class
+
+  { TDatabasePool }
+
+  TDatabasePool = class(TObjectList)
   private
-    HTTPSessionFile: THTTPSessionFile;
-    function PagesList(URL: string; Page, TotalCount, CountPerPage: Integer
-      ): string;
-    procedure ServerInfo(Request: THTTPRequest; Response: THTTPResponse);
+    Lock: TCriticalSection;
   public
-    HTTPServer: THTTPServer;
+    PoolSize: Integer;
     HostName: string;
     Schema: string;
     UserName: string;
     Password: string;
-
-    procedure ViewList(Request: THTTPRequest; Response: THTTPResponse);
-    procedure ViewItem(Request: THTTPRequest; Response: THTTPResponse);
-    procedure SendIndex(Request: THTTPRequest; Response: THTTPResponse);
+    procedure Allocate;
+    function Acquire: TSqlDatabase;
+    procedure Release(Database: TSqlDatabase);
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TWebServer }
+
+  TWebServer = class
+  private
+    SessionStorage: TFileHTTPSessionStorage;
+    procedure ServerInfo(HandlerData: THTTPHandlerData);
+  public
+    HTTPServer: THTTPServer;
+    DatabasePool: TDatabasePool;
+
+    procedure ViewList(HandlerData: THTTPHandlerData);
+    procedure ViewItem(HandlerData: THTTPHandlerData);
+    procedure SendIndex(HandlerData: THTTPHandlerData);
     procedure WriteHeader(Stream: TMemoryStreamEx);
     procedure WriteFooter(Stream: TMemoryStreamEx);
@@ -63 +77 @@
         with ChildNodes[I3] do begin
           if NodeName = 'hostname' then
-            HostName := TextContent;
+            DatabasePool.HostName := TextContent;
           if NodeName = 'schema' then
-            Schema := TextContent;
+            DatabasePool.Schema := TextContent;
           if NodeName = 'username' then
-            UserName := TextContent;
+            DatabasePool.UserName := TextContent;
           if NodeName = 'password' then
-            Password := TextContent;
+            DatabasePool.Password := TextContent;
         end;
         if NodeName = 'server' then
@@ -102 +116 @@
 end;
 
-function TWebServer.PagesList(URL: string; Page, TotalCount, CountPerPage: Integer): string;
-const
-  Around: Integer = 10;
-var
-  Count: Integer;
-  PagesMax: Integer;
-  PagesMin: Integer;
-  I: Integer;
-begin
-  Count := Round(TotalCount / CountPerPage);
-  Result := '';
-  if Count > 1 then begin
-    if Page > 0 then begin
-      Result := Result + '<a href="' + URL + '0">&lt;&lt;</a> ';
-      Result := Result + '<a href="' + URL + IntToStr(Page - 1) + '">&lt;</a> ';
-    end;
-    PagesMax := Count - 1;
-    PagesMin := 0;
-    if PagesMax > (Page + Around) then PagesMax := Page + Around;
-    if PagesMin < (Page - Around) then begin
-      Result := Result + ' .. ';
-      PagesMin := Page - Around;
-    end;
-    for I := PagesMin to PagesMax do begin
-      if I = Page then Result := Result + '<strong>';
-      Result := Result + '<a href="' + URL + IntToStr(I) + '">' + IntToStr(I + 1) + '</a> ';
-      if I = Page then Result := Result + '</strong>';
-    end;
-    if PagesMax < (Count - 1) then Result := Result + ' .. ';
-    if Page < (Count - 1) then begin
-      Result := Result + '<a href="' + URL + IntToStr(Page + 1) + '">&gt;</a> ';
-      Result := Result + '<a href="' + URL + IntToStr(Count - 1) + '">&gt;&gt;</a>';
-    end;
-  end;
-end;
-
-procedure TWebServer.ViewList(Request: THTTPRequest; Response: THTTPResponse);
+procedure TWebServer.ViewList(HandlerData: THTTPHandlerData);
 var
   SqlDatabase: TSqlDatabase;
@@ -147 +125 @@
   Title: string;
   LinkQuery: TQueryParameterList;
-begin
-  SqlDatabase := TSqlDatabase.Create;
-  with Response, Stream, SqlDatabase do
+  PageList: TPageList;
+begin
+  SqlDatabase := DatabasePool.Acquire;
+  with HandlerData, Response, Stream, SqlDatabase do
   begin
     WriteHeader(Stream);
-    HostName := Self.HostName;
-    UserName := Self.UserName;
-    Password := Self.Password;
-    Database := Self.Schema;
-    Connect;
-    WriteString(Request.Query.Values['Table']);
+
+    WriteString('<div align="center">');
+
+    // Prepare table paging
+    DbRows := Query('SELECT COUNT(*) FROM ' + Request.Query.Values['Table']);
+    PageList := TPageList.Create;
+    PageList.HandlerData := HandlerData;
+    with PageList do begin
+      TotalCount := StrToInt(DbRows[0].ValuesAtIndex[0]);
+      ItemPerPage := 20;
+      NavigatorVisibleItems := 5;
+      Process;
+    end;
+    DbRows.Destroy;
+
+    //WriteString(Request.Query.Values['Table']);
     OrderColumn    := Request.Query.Values['OrderCol'];
     OrderDirection := Request.Query.Values['OrderDir'];
@@ -165 +154 @@
       OrderDirection := 'DESC';
     DbRows := Query('SELECT * FROM ' + Request.Query.Values['Table'] +
-      ' ORDER BY ' + OrderColumn + ' ' + OrderDirection);
+      ' ORDER BY ' + OrderColumn + ' ' + OrderDirection + PageList.SQLLimit);
 
     LinkQuery := TQueryParameterList.Create;
     LinkQuery.Assign(Request.Query);
 
-    WriteString('<strong>Seznam typů karet</strong>');
+    WriteString('<strong>Seznam typů karet</strong><br/>');
+    WriteString(PageList.Output);
     WriteString('<table><tr>');
     if DbRows.Count > 0 then
@@ -197 +187 @@
     end;
     WriteString('</table>');
+    WriteString(PageList.Output);
+    WriteString('</div>');
+
     DbRows.Destroy;
     Destroy;
     WriteFooter(Stream);
   end;
-end;
-
-procedure TWebServer.ViewItem(Request: THTTPRequest; Response: THTTPResponse);
+  PageList.Destroy;
+end;
+
+procedure TWebServer.ViewItem(HandlerData: THTTPHandlerData);
 var
   SqlDatabase: TSqlDatabase;
@@ -214 +208 @@
 begin
   SqlDatabase := TSqlDatabase.Create;
-  with Response, Stream, SqlDatabase do
+  with HandlerData, Response, Stream, SqlDatabase do
   begin
     WriteHeader(Stream);
-    HostName := Self.HostName;
-    UserName := Self.UserName;
-    Password := Self.Password;
-    Database := Self.Schema;
-    Connect;
     DbRows := Query('SELECT * FROM ' + Request.Query.Values['Table'] +
       ' WHERE Id=' + Request.Query.Values['Id']);
@@ -239 +228 @@
 end;
 
-procedure TWebServer.ServerInfo(Request: THTTPRequest; Response: THTTPResponse);
+procedure TWebServer.ServerInfo(HandlerData: THTTPHandlerData);
 var
   I: Integer;
 begin
-  with Response.Stream do begin
-    Response.Cookies.Values['Test'] := 'Halo';
+  with HandlerData, Response.Stream do begin
+    //Response.Cookies.Values['Test'] := 'Halo';
     //Response.Cookies.Values['Test2'] := 'Halo2';
 
-    HTTPServer.SessionHandler.Variables.Values['Session1'] := 'Value1';
+    //HTTPServer.SessionHandler.Variables.Values['Session1'] := 'Value1';
     //HTTPServer.SessionHandler.Variables.Values['Session2'] := 'Value2';
 
@@ -263 +252 @@
 
     WriteString('<h5>Session variables</h5>');
-    for I := 0 to HTTPServer.SessionHandler.Variables.Count - 1 do begin;
-      WriteString(HTTPServer.SessionHandler.Variables.Strings[I] + '<br/>');
+    for I := 0 to Session.Count - 1 do begin;
+      WriteString(Session.Strings[I] + '<br/>');
     end;
 
@@ -275 +264 @@
 end;
 
-procedure TWebServer.SendIndex(Request: THTTPRequest; Response: THTTPResponse);
-begin
-  with Response, Stream do
+procedure TWebServer.SendIndex(HandlerData: THTTPHandlerData);
+begin
+  with HandlerData, Response, Stream do
   begin
     WriteHeader(Stream);
-    WriteString('<img src="logo.png"/><br/>');
-    WriteString('<strong>Congratulations</strong>');
-    WriteString('<hr/>');
-    WriteString('Your PWU LightWebServer based application is running.<br/>');
-    WriteString('<hr/>');
-    WriteString('Generated ' + RFC822DateTime(Now) + ' by PWU LightWebServer.');
+
+
     WriteFooter(Stream);
   end;
@@ -324 +309 @@
 begin
   inherited Create;
-  HTTPSessionFile := THTTPSessionFile.Create;
-  with HTTPSessionFile do begin
-  end;
+  DatabasePool := TDatabasePool.Create;
+  DatabasePool.Capacity := 20;
+  DatabasePool.Allocate;
+
+  SessionStorage := TFileHTTPSessionStorage.Create;
   HTTPServer := THTTPServer.Create;
   with HTTPServer, Socket do begin
-    SessionHandler := HTTPSessionFile;
+    SessionStorage := Self.SessionStorage;
     DocumentRoot := 'Data';
     with RequestHandlerList do begin
@@ -346 +333 @@
 destructor TWebServer.Destroy;
 begin
+  DatabasePool.Destroy;
   HTTPServer.Destroy;
-  HTTPSessionFile.Destroy;
+  SessionStorage.Destroy;
   inherited Destroy;
 end;
 
+{ TDatabasePool }
+
+procedure TDatabasePool.Allocate;
+var
+  I: Integer;
+begin
+  for I := 0 to PoolSize - 1 do
+    with TSqlDatabase(Items[Add(TSqlDatabase.Create)]) do begin
+      HostName := Self.HostName;
+      UserName := Self.UserName;
+      Password := Self.Password;
+      Database := Self.Schema;
+      Connect;
+    end;
+end;
+
+function TDatabasePool.Acquire: TSqlDatabase;
+begin
+
+end;
+
+procedure TDatabasePool.Release(Database: TSqlDatabase);
+begin
+  try
+    Lock.Acquire;
+
+  finally
+    Lock.Release;
+  end;
+end;
+
+constructor TDatabasePool.Create;
+begin
+  Lock := TCriticalSection.Create;
+end;
+
+destructor TDatabasePool.Destroy;
+begin
+  Lock.Destroy;
+  inherited Destroy;
+end;
+
 end.