Changeset 88 for branches/DirectWeb/UTCPServer.pas

Timestamp:

Dec 18, 2009, 12:21:39 PM (15 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/UTCPServer.pas (modified) (11 diffs)

branches/DirectWeb/UTCPServer.pas

@@ -13 +13 @@
   //LibC,
   {$ENDIF}
-  BlckSock;
+  BlckSock, UPool, UResetableThread;
 
 type
   TTCPServer = class;
-  TTCPClientList = class;
 
   { TTCPClientThread }
 
-  TTCPClientThread = class(TThread)
-    Parent: TTCPClientList;
+  TTCPClientThread = class(TResetableThread)
+    Parent: TTCPServer;
     Socket: TTCPBlockSocket;
     procedure Execute; override;
-    constructor Create(CreateSuspended: Boolean;
-      const StackSize: SizeUInt = DefaultStackSize);
+    constructor Create;
     destructor Destroy; override;
+  end;
+
+  { TClientThreadedPool }
+
+  TClientThreadedPool = class(TThreadedPool)
+  private
+    FActive: Boolean;
+    procedure SetActive(const AValue: Boolean);
+  public
+    property Active: Boolean read FActive write SetActive;
   end;
 
@@ -35 +43 @@
     Parent: TTCPServer;
     procedure Execute; override;
-  end;
-
-  { TTCPClientList }
-
-  TTCPClientList = class(TList)
-    Parent: TTCPServer;
-    procedure Add(ASocket: TSocket);
-    procedure Remove(Item: TTCPClientThread);
-    procedure Terminate;
-    procedure WaitFor;
-    constructor Create;
-    destructor Destroy; override;
   end;
 
@@ -59 +55 @@
     procedure SetActive(const AValue: Boolean);
   public
-    Clients: TTCPClientList;
+    ThreadPool: TClientThreadedPool;
     Address: string;
     Port: Word;
@@ -77 +73 @@
   if AValue and not FActive then begin
     with Socket do begin
+      ThreadPool.Active := True;
       CreateSocket;
       SetLinger(True, 10);
@@ -96 +93 @@
       AcceptThread.WaitFor;
       AcceptThread.Destroy;
-      Clients.Terminate;
-      Clients.WaitFor;
+      ThreadPool.Active := False;
       CloseSocket;
     end;
@@ -105 +101 @@
 
 constructor TTCPServer.Create;
+var
+  I: Integer;
 begin
-  Clients := TTCPClientList.Create;
-  Clients.Parent := Self;
+  ThreadPool := TClientThreadedPool.Create;
+  ThreadPool.TotalCount := 10;
+
   Socket := TTCPBlockSocket.Create;
   Address := '0.0.0.0';
@@ -115 +114 @@
 destructor TTCPServer.Destroy;
 begin
+  ThreadPool.Destroy;
   Active := False;
   Socket.Destroy;
-  Clients.Destroy;
   inherited Destroy;
 end;
@@ -126 +125 @@
 var
   NewSocket: TSocket;
+  NewObject: TTCPClientThread;
 begin
   repeat
@@ -131 +131 @@
       NewSocket := Parent.Socket.Accept;
       if Parent.Socket.LastError = 0 then begin
-        Parent.Clients.Add(NewSocket);
+        NewObject := TTCPClientThread(Parent.ThreadPool.Acquire);
+        NewObject.Parent := Parent;
+        NewObject.Socket.Socket := NewSocket;
+        NewObject.Start;
       end;
     end;
   until Terminated;
-end;
-
-{ TTCPClientList }
-
-procedure TTCPClientList.Add(ASocket: TSocket);
-begin
-  with TTCPClientThread(Items[inherited Add(TTCPClientThread.Create(True))]) do begin
-    Socket.Socket := ASocket;
-    Parent := Self;
-    Resume;
-  end;
-end;
-
-procedure TTCPClientList.Remove(Item: TTCPClientThread);
-begin
-  inherited Remove(Item);
-  Item.Destroy;
-end;
-
-procedure TTCPClientList.Terminate;
-var
-  I: Integer;
-begin
-  for I := 0 to Count - 1 do
-    TTCPClientThread(Items[I]).Terminate;
-end;
-
-procedure TTCPClientList.WaitFor;
-var
-  I: Integer;
-begin
-  for I := 0 to Count - 1 do
-    TTCPClientThread(Items[I]).WaitFor;
-end;
-
-constructor TTCPClientList.Create;
-begin
-  inherited;
-end;
-
-destructor TTCPClientList.Destroy;
-var
-  I: Integer;
-begin
-  for I := 0 to Count - 1 do
-    TTCPClientThread(Items[I]).Destroy;
-  inherited Destroy;
 end;
 
@@ -188 +144 @@
 procedure TTCPClientThread.Execute;
 begin
-  if Assigned(Parent.Parent.FOnClientConnect) then
-    Parent.Parent.FOnClientConnect(Self);
-  Parent.Remove(Self);
+  if Assigned(Parent.FOnClientConnect) then
+    Parent.FOnClientConnect(Self);
 end;
 
-constructor TTCPClientThread.Create(CreateSuspended: Boolean;
-  const StackSize: SizeUInt);
+constructor TTCPClientThread.Create;
 begin
-  inherited Create(CreateSuspended, StackSize);
+  inherited;
   Socket := TTCPBlockSocket.Create;
 end;
@@ -202 +156 @@
 destructor TTCPClientThread.Destroy;
 begin
-  //Socket.Destroy;
-  inherited Destroy;
+  Socket.Destroy;
+  inherited;
+end;
+
+{ TClientThreadedPool }
+
+procedure TClientThreadedPool.SetActive(const AValue: Boolean);
+var
+  I: Integer;
+begin
+  if not FActive and Active then begin
+    Allocate;
+    for I := 0 to TotalCount - 1 do begin
+      TThreadedPoolItem(Items[I]).Item := TTCPClientThread.Create;
+    end;
+  end else
+  if FActive and not Active then begin
+
+  end;
+  FActive := Active;
 end;