* Some fixes and additional unit from Darius Blaszijk

git-svn-id: trunk@18182 -

packages/fcl-web/src/base/fphttpserver.pp

@@ -37,6 +37,7 @@ Type
     FConnection: TFPHTTPConnection;
   protected
     procedure SetContent(AValue : String);
+  published
     Property Connection : TFPHTTPConnection Read FConnection;
   end;
 
@@ -93,12 +94,15 @@ Type
 
   TFPCustomHttpServer = Class(TComponent)
   Private
+    FAdminMail: string;
+    FAdminName: string;
     FOnAllowConnect: TConnectQuery;
     FOnRequest: THTTPServerRequestHandler;
     FPort: Word;
     FQueueSize: Word;
     FServer : TInetServer;
     FLoadActivate : Boolean;
+    FServerBanner: string;
     FThreaded: Boolean;
     function GetActive: Boolean;
     procedure SetActive(const AValue: Boolean);
@@ -138,6 +142,12 @@ Type
     property Threaded : Boolean read FThreaded Write SetThreaded;
     // Called to handle the request. If Threaded=True, it is called in a the connection thread.
     Property OnRequest : THTTPServerRequestHandler Read FOnRequest Write FOnRequest;
+
+  published
+    //aditional server information
+    property AdminMail: string read FAdminMail write FAdminMail;
+    property AdminName: string read FAdminName write FAdminName;
+    property ServerBanner: string read FServerBanner write FServerBanner;
   end;
 
   TFPHttpServer = Class(TFPCustomHttpServer)
@@ -152,6 +162,8 @@ Type
 
   EHTTPServer = Class(Exception);
 
+  Function GetStatusCode (ACode: Integer) : String;
+
 implementation
 
 resourcestring
@@ -426,8 +438,7 @@ begin
   Until (S='');
 end;
 
-constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream
-  );
+constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream);
 begin
   FSocket:=ASocket;
   FServer:=AServer;
@@ -448,6 +459,8 @@ Var
 begin
   // Read headers.
   Req:=ReadRequestHeaders;
+  //set port
+  Req.ServerPort := Server.Port;
   try
     // Read content, if any
     If Req.ContentLength>0 then
@@ -611,6 +624,7 @@ begin
   inherited Create(AOwner);
   FPort:=80;
   FQueueSize:=5;
+  FServerBanner := 'Freepascal';
 end;
 
 destructor TFPCustomHttpServer.Destroy;

packages/fcl-web/src/base/httpdefs.pp

@@ -187,6 +187,7 @@ type
     Procedure SetContentLength(Value : Integer);
     Function GetFieldIndex(AIndex : Integer) : Integer;
     Function GetServerPort : Word;
+    Procedure SetServerPort(AValue : Word);
     Function GetSetFieldValue(Index : Integer) : String; virtual;
   Protected
     Function GetFieldValue(Index : Integer) : String; virtual;
@@ -241,7 +242,7 @@ type
     Property RemoteAddr : String Index 27 read GetFieldValue Write SetFieldValue; // Alias, Delphi-compat
     Property RemoteHost : String Index 28 read  GetFieldValue Write SetFieldValue;
     Property ScriptName : String Index 29 read  GetFieldValue Write SetFieldValue;
-    Property ServerPort : Word Read GetServerPort; // Index 30
+    Property ServerPort : Word Read GetServerPort Write SetServerPort; // Index 30
     Property HTTPAccept : String Index 1 read GetFieldValue Write SetFieldValue;
     Property HTTPAcceptCharset : String Index 2 read GetFieldValue Write SetFieldValue;
     Property HTTPAcceptEncoding : String Index 3 read GetFieldValue Write SetFieldValue;
@@ -273,6 +274,7 @@ type
     FFiles : TUploadedFiles;
     FReturnedPathInfo : String;
     FLocalPathPrefix : string;
+    FServerPort : String;
     function GetLocalPathPrefix: string;
     function GetFirstHeaderLine: String;
   Protected
@@ -594,6 +596,12 @@ begin
   Result:=StrToIntDef(GetFieldValue(30),0);
 end;
 
+Procedure THTTPHeader.SetServerPort(AValue : Word);
+
+begin
+  SetFieldValue(30,IntToStr(AValue));
+end;
+    
 function THTTPHeader.GetSetFieldValue(Index: Integer): String;
 
 Var
@@ -674,7 +682,7 @@ begin
       27 : ; // Property RemoteAddress : String Index 27 read GetFieldValue Write SetFieldValue;
       28 : ; // Property RemoteHost : String Index 28 read  GetFieldValue Write SetFieldValue;
       29 : ; // Property ScriptName : String Index 29 read  GetFieldValue Write SetFieldValue;
-      30 : ; // Property ServerPort : Word Read GetServerPort; // Index 30
+      30 : ; // Property ServerPort : Word Read GetServerPort; // Index 30 in TRequest
       36 : FHTTPXRequestedWith:=Value;
     end;
 end;
@@ -1042,6 +1050,7 @@ procedure TRequest.SetFieldValue(Index: Integer; Value: String);
 begin
   Case Index of
     25 : FPathInfo:=Value;
+    30 : FServerPort:=Value;
     31 : FCommand:=Value;
     32 : FURI:=Value;
   else