Changeset 311 for Network/CoolWeb/WebServer/UWebApp.pas

Timestamp:

Jan 4, 2012, 2:27:19 PM (12 years ago)

Author:

chronos

Message:

• Added: Support for handling POST values in HTTPServer.
• Fixed: TCP server to start listening and wait for termination.
• Added: ServerType of WebApp as CGI or TCP.

File:

• Network/CoolWeb/WebServer/UWebApp.pas (modified) (7 diffs)

Network/CoolWeb/WebServer/UWebApp.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
-  UHTTPServer, UHTTPServerCGI;
+  UHTTPServer;
 
 type
+  THTTPServerType = (stCGI, stTCP);
+
   TRegistredPage = class
     Name: string;
@@ -25 +27 @@
   TWebApp = class(TCustomApplication)
   private
+    FOnBeforePageProduce: TOnProduceEvent;
     FOnInitialize: TNotifyEvent;
+    FServerType: THTTPServerType;
     procedure DoRun; override;
     function DumpExceptionCallStack(E: Exception): string;
     procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
+    procedure SetServerType(AValue: THTTPServerType);
   public
     Pages: TRegistredPageList;
@@ -38 +43 @@
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    property OnBeforePageProduce: TOnProduceEvent read FOnBeforePageProduce write FOnBeforePageProduce;
     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
+    property ServerType: THTTPServerType read FServerType write SetServerType;
   end;
 
@@ -49 +56 @@
 
 implementation
+
+uses
+  UHTTPServerCGI, UHTTPServerTCP;
 
 resourcestring
@@ -125 +135 @@
     //Request.QueryParts[0] := 'uzivatel';
     //Request.QueryParts[1] := 'prihlaseni';
+    if Assigned(FOnBeforePageProduce) then
+      FOnBeforePageProduce(HandlerData);
 
     if Request.QueryParts.Count > 0 then PageName := Request.QueryParts[0]
@@ -131 +143 @@
     if Assigned(Page) then begin
       Page.Page.OnProduce(HandlerData);
-    end else Response.Stream.WriteString(SPageNotFound);
-  end;
+    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;
 
@@ -152 +176 @@
     hstdout := @stderr;
     Writeln(hstdout^, 'An unhandled exception occurred: ' + E.Message + '<br>');
-    WriteLn(hstdout^, StringReplace(DumpExceptionCallStack(E), LineEnding, '<br>', [rfReplaceAll]));
+    WriteLn(hstdout^, DumpExceptionCallStack(E));
   end;
 end;