Procházet zdrojové kódy

* Merging revisions r49276,r49277 from trunk:
------------------------------------------------------------------------
r49276 | michael | 2021-04-27 13:16:58 +0200 (Tue, 27 Apr 2021) | 1 line

* Make some properties public
------------------------------------------------------------------------
r49277 | michael | 2021-04-27 13:30:53 +0200 (Tue, 27 Apr 2021) | 1 line

* Forgot to include sslbase
------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@49300 -

michael před 4 roky
rodič
revize
68ed01ed6c
1 změnil soubory, kde provedl 13 přidání a 3 odebrání
  1. 13 3
      packages/fcl-web/src/base/custhttpapp.pp

+ 13 - 3
packages/fcl-web/src/base/custhttpapp.pp

@@ -21,7 +21,7 @@ unit custhttpapp;
 Interface
 
 uses
-  Classes, SysUtils, httpdefs, custweb, ssockets,  fphttpserver;
+  Classes, SysUtils, httpdefs, custweb, ssockets,  fphttpserver, sslbase;
 
 Type
   TCustomHTTPApplication = Class;
@@ -76,7 +76,6 @@ Type
     Procedure InitResponse(AResponse : TResponse); override;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     Function CreateServer : TEmbeddedHttpServer; virtual;
-    Property HTTPServer : TEmbeddedHttpServer Read FServer;
   Public
     Procedure Run; override;
     Procedure Terminate; override;
@@ -104,6 +103,8 @@ Type
     Property UseSSL : Boolean Read GetUseSSL Write SetUseSSL;
     // HostName to use when using SSL
     Property HostName : String Read GetHostName Write SetHostName;
+    // Access to server so you can set certificate data
+    Property HTTPServer : TEmbeddedHttpServer Read FServer;
   end;
 
   { TCustomHTTPApplication }
@@ -111,6 +112,7 @@ Type
   TCustomHTTPApplication = Class(TCustomWebApplication)
   private
     procedure FakeConnect;
+    function GetCertificateData: TCertificateData;
     function GetHostName: String;
     function GetIdle: TNotifyEvent;
     function GetIDleTimeOut: Cardinal;
@@ -133,9 +135,10 @@ Type
     procedure SetUseSSL(AValue: Boolean);
   protected
     function InitializeWebHandler: TWebHandler; override;
-    Function HTTPHandler : TFPHTTPServerHandler;
   Public
     procedure Terminate; override;
+    // Access to HTTP handler
+    Function HTTPHandler : TFPHTTPServerHandler;
     Property Address : string Read GetAddress Write SetAddress;
     Property Port : Word Read GetPort Write SetPort Default 80;
     // Max connections on queue (for Listen call)
@@ -154,6 +157,8 @@ Type
     Property UseSSL : Boolean Read GetUseSSL Write SetUseSSL;
     // Hostname to use when using SSL
     Property HostName : String Read GetHostName Write SetHostName;
+    // Access to certificate data
+    Property CertificateData : TCertificateData Read GetCertificateData;
   end;
 
 
@@ -296,6 +301,11 @@ begin
   end
 end;
 
+function TCustomHTTPApplication.GetCertificateData: TCertificateData;
+begin
+  Result:=HTTPHandler.HTTPServer.CertificateData;
+end;
+
 function TCustomHTTPApplication.GetHostName: String;
 begin
   Result:=HTTPHandler.HostName;