Changeset 89 for branches/DirectWeb/UWebServer.pas

Timestamp:

Dec 18, 2009, 1:42:22 PM (15 years ago)

Author:

george

Message:

• Opraveno: Chybné vytváření pojmenovaných objektů TEvent.
• Opraveno: Chybné přidělování a uvolňování zásobníků vláken a databázových spojení.
• Opraveno: Chybná inicializace parametrů databázových spojení.

File:

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

branches/DirectWeb/UWebServer.pas

@@ -10 +10 @@
   UCommon, syncobjs,
   UMemoryStreamEx,
-  UMIMEType, Synautil,
+  UMIMEType, Synautil, UPool,
   USqlDatabase, DOM, XMLRead, UHTMLControls;
 
@@ -20 +20 @@
   { TDatabasePool }
 
-  TDatabasePool = class(TObjectList)
+  TDatabasePool = class(TThreadedPool)
   private
-    Lock: TCriticalSection;
+    FActive: Boolean;
+    procedure SetActive(const AValue: Boolean);
   public
-    PoolSize: Integer;
+    property Active: Boolean read FActive write SetActive;
+  public
     HostName: string;
     Schema: string;
     UserName: string;
     Password: string;
-    procedure Allocate;
-    function Acquire: TSqlDatabase;
-    procedure Release(Database: TSqlDatabase);
     constructor Create;
     destructor Destroy; override;
@@ -103 +102 @@
   Command: string;
 begin
+  LoadConfiguration;
+  DatabasePool.Active := True;
   WriteLn('WoW hosting web server');
-  LoadConfiguration;
   with HTTPServer do begin
     Socket.Active := True;
@@ -127 +127 @@
   PageList: TPageList;
 begin
-  SqlDatabase := DatabasePool.Acquire;
+  SqlDatabase := TSqlDatabase(DatabasePool.Acquire);
   with HandlerData, Response, Stream, SqlDatabase do
   begin
@@ -191 +191 @@
 
     DbRows.Destroy;
-    Destroy;
     WriteFooter(Stream);
   end;
   PageList.Destroy;
+  DatabasePool.Release(SqlDatabase);
 end;
 
@@ -207 +207 @@
   LinkQuery: TQueryParameterList;
 begin
-  SqlDatabase := TSqlDatabase.Create;
+  SqlDatabase := TSqlDatabase(DatabasePool.Acquire);
   with HandlerData, Response, Stream, SqlDatabase do
   begin
@@ -223 +223 @@
     WriteString('</table>');
     DbRows.Destroy;
-    Destroy;
     WriteFooter(Stream);
   end;
+  DatabasePool.Release(SqlDatabase);
 end;
 
@@ -269 +269 @@
   begin
     WriteHeader(Stream);
-
-
+    WriteString('Index');
     WriteFooter(Stream);
   end;
@@ -310 +309 @@
   inherited Create;
   DatabasePool := TDatabasePool.Create;
-  DatabasePool.Capacity := 20;
-  DatabasePool.Allocate;
+  DatabasePool.TotalCount := 20;
 
   SessionStorage := TFileHTTPSessionStorage.Create;
@@ -341 +339 @@
 { TDatabasePool }
 
-procedure TDatabasePool.Allocate;
+procedure TDatabasePool.SetActive(const AValue: Boolean);
 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;
+  if not FActive and AValue then begin
+    for I := 0 to TotalCount - 1 do
+    with TThreadedPoolItem(Items[I]) do begin
+      Item := TSqlDatabase.Create;
+      with TSqlDatabase(Item) do begin
+        HostName := Self.HostName;
+        UserName := Self.UserName;
+        Password := Self.Password;
+        Database := Self.Schema;
+        Connect;
+      end;
+    end;
+  end else
+  if FActive and not AValue then begin
+
+  end;
+  FActive := AValue;
 end;
 
 constructor TDatabasePool.Create;
 begin
-  Lock := TCriticalSection.Create;
+  inherited;
 end;
 
 destructor TDatabasePool.Destroy;
 begin
-  Lock.Destroy;
   inherited Destroy;
 end;