Changeset 68 for trunk/Components/CoolWeb/WebServer/UWebApp.pas

Timestamp:

Dec 26, 2011, 12:07:37 PM (12 years ago)

Author:

chronos

Message:

• Upraveno: Testování varianty HTTP serveru jako přímé obsluhy přes TCP. Momentálně není odděleno generování stránek pro použití z více vláken.
• Upraveno: Třída uchování jména počítač nyní pro převod do IPv4 používá ověření správnosti namísto přímého převodu a zahlášení výjimky.

File:

• trunk/Components/CoolWeb/WebServer/UWebApp.pas (modified) (5 diffs)

trunk/Components/CoolWeb/WebServer/UWebApp.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
-  UHTTPServer, UHTTPServerCGI;
+  UHTTPServer;
 
 type
+  THTTPServerType = (stCGI, stTCP);
+
   TRegistredPage = class
     Name: string;
@@ -26 +28 @@
   private
     FOnInitialize: TNotifyEvent;
+    FServerType: THTTPServerType;
     procedure DoRun; override;
     function DumpExceptionCallStack(E: Exception): string;
     procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
+    procedure SetServerType(AValue: THTTPServerType);
   public
     Pages: TRegistredPageList;
@@ -39 +43 @@
     destructor Destroy; override;
     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
+    property ServerType: THTTPServerType read FServerType write SetServerType;
   end;
 
@@ -49 +54 @@
 
 implementation
+
+uses
+  UHTTPServerCGI, UHTTPServerTCP;
 
 resourcestring
@@ -133 +141 @@
     end else Response.Content.WriteString(SPageNotFound);
   end;
+end;
+
+procedure TWebApp.SetServerType(AValue: THTTPServerType);
+begin
+  if FServerType = AValue then Exit;
+  FServerType := AValue;
+  HTTPServer.Free;
+  case FServerType of
+    stCGI: HTTPServer := THTTPServerCGI.Create(nil);
+    stTCP: HTTPServer := THTTPServerTCP.Create(nil);
+  end;
+  HTTPServer.OnRequest := HTTPServerRequest;
 end;