使用http.sys，讓delphi 的多層服務飛起來

      一直以來，delphi 的網絡通訊層都是以indy 為主，雖然indy 的功能非常多，涉及到網絡服務的

各個方面，但是對於大多數多層服務來說，就是需要一個快速、穩定、高效的傳輸層。Delphi 的 datasnap

主要通過三種實現數據通訊的，一種是大家恨得牙癢癢的indy，另外一種是通過iis 的isapi，最后一種是通過

apache  的動態模塊(DSO) 來實現。

     indy 的問題多多，大家基本上都是趨向使用后兩種方式，后面兩種方式的麻煩是必須安裝IIS 或者是

Apache。用起來還要配置很多東西，也不是太方便。

   還好，微軟在Windows Vista (server 2008) 以后使用http.sys 作為web 服務的核心，IIS 也是通過這個核心

實現其web 服務的。使用http.sys 都有哪些優勢呢?

       1.不用做額外的編碼，直接支持https（媽媽再也不用擔心ios 10 要 https 了）

       2.內核級的緩沖和內核級的請求隊列(大大降低應用服務器自身的壓力)

       3.多個應用程序可以使用同一個端口(防火牆表示很欣慰)

       4.內核級的SSL 支持

       5.內核級的靜態文件輸出支持(下載一個4G的文件試試)

       6.理論上，這是windows 下最快的http 服務，沒有之一。

這么多好處，那么我們是否可以在delphi 里面直接使用http.sys ，讓delphi 的多層服務在windows 下飛起來?

    答案是肯定的，delphi 完全可以非常順利的使用http.sys  服務，不光是webbroke, datasanp, 包括我們常用的kbmmw.

目前delphi 的第三方控件里面支持http.sys 的主要有兩個，一個是著名的控件商TMS， 其專門有一個控件叫TMS Sparkle，

主要就是封裝http.sys 服務，這個公司的其他的一些多層控件都是架構在這個控件上的，唯一不好的是，它是商業軟件，需要

付費購買。另外一個就是著名的開源框架mormot。此作者的功力已經是恐龍級，可以進delphi  界牛人前十名。他在mormot

里面也封裝了 http.sys. 由於是開源的，所以是需要自己把對應封裝的代碼拿出來，實現與delphi 現有的多層應用適配。

   下面以mormot  封裝的 THttpApiServer 為例，說明一下在多層應用中如何使用適配使用http.sys.

我們首先解決webbroker 中如何使用THttpApiServer？

 其實如果大家對webbroker  比較了解的話，就知道webbroker 的工作原理就是把客戶端來的請求分發到webbroker 的處理過程，

然后再把返回結果響應給客戶端。那么我們需要做一個winapiWebBrokerBridge,功能就是完成以上要求。

首先下載mormot 源碼，添加相關目錄。

然后加入我們的單元，需要使用的相關對象聲明如下：

unit winapiWebBrokerBridge;

{
by xalion  2016.12.25
}

interface


uses
  Classes,
  HTTPApp,
  SysUtils,
  system.NetEncoding,
  SynCommons,
  SynZip,
  SynCrtSock ,

  WebBroker, WebReq;

type
  EWBBException = class(EWebBrokerException);
  EWBBInvalidIdxGetDateVariable = class(EWBBException);
  EWBBInvalidIdxSetDateVariable = class(EWBBException );
  EWBBInvalidIdxGetIntVariable = class(EWBBException );
  EWBBInvalidIdxSetIntVariable = class(EWBBException );
  EWBBInvalidIdxGetStrVariable = class(EWBBException);
  EWBBInvalidIdxSetStringVar = class(EWBBException);
  EWBBInvalidStringVar = class(EWBBException);


 Twinapirequestinfo=class(Tobject)
 protected
   FHttpServerRequest:THttpServerRequest;
   Finrawheaders:Tstringlist;
   FContentStream : TStream;
   FFreeContentStream : Boolean;
   Fhost:string;
   Fport:string;
   Fcontent:string;
   FURL:string;
   Fremoteip:string;
   Fcontentlength:integer;
   fInContentType:string;

   Fcommand:string;
 public
    constructor Create(C: THttpServerRequest);
    destructor Destroy; override;
 end;

 Twinapiresponseinfo=class(Tobject)
  protected
   FHttpServerRequest:THttpServerRequest;
   Foutrawheaders:Tstringlist;
   FContentStream : TStream;
   FFreeContentStream : Boolean;
   Fhost:string;
   Fport:string;
   Fcontent:string;
   Fcontenttype:string;
   Fcontentlength:integer;
   Fstatuscode:integer;
   FCookies: TCookieCollection;
 public
    constructor Create(C: THttpServerRequest);
    destructor Destroy; override;
    procedure AddCookiestohead;
 end;



 TwinapiAppRequest = class(TWebRequest)
  protected
    FRequestInfo   : TwinapiRequestInfo;
    FResponseInfo  : TwinapiResponseInfo;
      FFreeContentStream : Boolean;
    FStatusCode:integer;
    //
    function GetDateVariable(Index: Integer): TDateTime; override;
    function GetIntegerVariable(Index: Integer): Integer; override;
    function GetStringVariable(Index: Integer): string; override;
    function GetRemoteIP: string; override;
    function GetRawPathInfo:string; override;
    function GetRawContent: TBytes; override;

  public
    constructor Create(arequestinfo:Twinapirequestinfo; aresponseinfo:Twinapiresponseinfo);
    destructor Destroy; override;
    function GetFieldByName(const Name: string): string; override;

    function ReadClient(var Buffer; Count: Integer): Integer; override;
    function ReadString(Count: Integer):string; override;
     function TranslateURI(const URI: string): string; override;

    function WriteHeaders(StatusCode: Integer; const ReasonString, Headers: string): Boolean; override;

  end;

  TwinapiAppResponse = class(TWebResponse)
  protected

     FRequestInfo   : TwinapiRequestInfo;
    FResponseInfo  : TwinapiResponseInfo;
   function GetContent: string; override;
     function GetStatusCode: Integer; override;
     procedure SetContent(const AValue: string); override;
    procedure SetContentStream(AValue: TStream); override;
    procedure SetStatusCode(AValue: Integer); override;
    procedure SetStringVariable(Index: Integer; const Value:string); override;
    procedure SetDateVariable(Index: Integer; const Value: TDateTime); override;
    procedure SetIntegerVariable(Index: Integer; Value: Integer); override;

  public
    constructor  Create(AHTTPRequest: TWebRequest;arequestinfo:Twinapirequestinfo; aresponseinfo:Twinapiresponseinfo);
     destructor Destroy; override;
    procedure SendRedirect(const URI: string); override;
    procedure SendResponse; override;
    procedure SendStream(AStream: TStream); override;
    function Sent: Boolean; override;
  end;

  TwinapiWebBrokerBridge = class(THttpApiServer)
  private
   // procedure RunWebModuleClass(C : THttpServerRequest);
  protected
    FWebModuleClass: TComponentClass;
   function Request(C : THttpServerRequest): cardinal;override;

  public
    procedure RegisterWebModuleClass(AClass: TComponentClass);

  end;

 

然后我們就可以使用這個，實現我們的webbroker 應用了。

我們使用delphi 自帶的向導，開始建一個webserver.

 

 點ok，繼續

 

 點完成。

生成對應的工程文件，然后我們替換主窗體的代碼。

 

 

主程序對應的代碼很簡單。

unit mainp;

interface

uses
  Winapi.Messages, System.SysUtils, System.Variants,  SynCrtSock,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.AppEvnts, Vcl.StdCtrls, winapiWebBrokerBridge, Web.HTTPApp;

type
  TForm1 = class(TForm)
    ButtonStart: TButton;
    ButtonStop: TButton;
    EditPort: TEdit;
    Label1: TLabel;
    ApplicationEvents1: TApplicationEvents;
    ButtonOpenBrowser: TButton;
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
    procedure ButtonOpenBrowserClick(Sender: TObject);
  private
    FServer: TwinapiWebBrokerBridge;
    procedure StartServer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  WinApi.Windows, Winapi.ShellApi;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
  if fserver=nil then
    begin
        ButtonStart.Enabled :=True;
         ButtonStop.Enabled :=false;
         EditPort.Enabled := True;
    end
    else
      begin
         ButtonStart.Enabled := not FServer.Started;
         ButtonStop.Enabled := FServer.Started ;
         EditPort.Enabled := not FServer.Started;
      end;
end;

procedure TForm1.ButtonOpenBrowserClick(Sender: TObject);
var
  LURL: string;
begin

  LURL := Format('http://localhost:%s', [EditPort.Text]);
  ShellExecute(0,
        nil,
        PChar(LURL), nil, nil, SW_SHOWNOACTIVATE);
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  StartServer;
end;

procedure TForm1.ButtonStopClick(Sender: TObject);
begin

   freeandnil( FServer);


end;

procedure TForm1.StartServer;
begin


  FServer := TwinapiWebBrokerBridge.Create(True);


  Fserver.Clone(10);// 開始10個進程
  Fserver.AddUrl('/','8080',false,'+',true);
  fserver.Start;


end;

webmodel 里面就很簡單了

procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);

begin

    response.Content:='你好！'

end;

 

然后我們開始運行這個程序。

打開瀏覽器，就會發現，我們的webbroker 程序運行正常。

 

 webbroker 服務器成功了，那么常用的webservice 也就不在話下了。

根據自帶的向導，替換對應的主主窗體的文件，運行，棒棒噠。

有同學質疑，這個真的是http.sys提供的服務嗎？

那么有圖有真相：

 

 datasnap  的·例子就不再演示了，方法與上面差不多。

 

最后，對於不使用datasnap,使用kbmmw  的同學，不用擔心，在kbmmw   里面照樣可以使用http.sys ,

只不過是要寫對應的transport.下面給出服務端和客戶端的對象聲明。

unit kbmMWHTTPAPIServerTransport;

{$define httpsyslog}

interface

uses
  Classes, Sysutils,
  kbmMWCustomTransport,kbmMWServer,kbmMWGlobal, variants, kbmMWHTTPUtils,
   {$ifdef httpsyslog}
       kbmMWLog,
  {$endif}

  SynCommons,
  SynZip,
  SynCrtSock;

type

  TProtServer = class(TkbmMWServer);
  TxalionTransport=class(TkbmMWCustomServerTransport);

  Txalioninfo=class(TkbmMWServerTransportInfo);


  Txalionserver = class
  private
         FServer:Tkbmmwserver;
         FTransport: TkbmMWCustomServerTransport;

         fPath: TFileName;
         fapiServer: THttpApiServer;
      function Process(C : THttpServerRequest): cardinal;
  public
  
    destructor Destroy; override;


  end;

  TkbmMWCustomhttpapiServerTransport = class(TkbmMWCustomServerTransport)
  private
    { Private declarations }


      FhttpsysServer: TxalionServer;

      Fhost:string;
      Fport:string;
      FServerUrl:string;
      Fssl:boolean;
      Fversion:string;
      FHTTPQueueLength: integer;

      FServerThreadPoolCount :integer;

  public
    // @exclude
    constructor Create(AOwner:TComponent); override;
    // @exclude
    destructor Destroy; override;

  public
     class function IsSerializedTransport:boolean; override;
     class function IsConnectionlessTransport:boolean; override;

     procedure Listen; override;
     procedure Close; override;
    function IsListening:boolean; override;

  published
    { 設置url   例如/kbmmw}
    property ServerURL:string read Fserverurl write Fserverurl;

    { 服務器 ip    例如   127.0.0.1}
    property Host:string read Fhost write Fhost;


    property Port:string read Fport write Fport;

    property SSL:boolean read fssl write fssl;


    Property Version:string read Fversion;
 
    property HTTPQueueLength: integer read FHTTPQueueLength write FHTTPQueueLength;
 
     property ServerThreadPoolCount: integer read FServerThreadPoolCount write FServerThreadPoolCount;

  end;

  TkbmMWhttpapiServerTransport= class(TkbmMWCustomhttpapiServerTransport)
  published
    { Published declarations }

    property Crypt;
    property Compression;
    property StreamFormat;
    property VerifyTransfer;
    property TransportStateOptions;
    property FormatSettings;
    property Plugin;
    property Params;
    property StringConversion;
    property NodeID;
    property ClusterID;
  end;
 {$I httpsysversion.inc}

unit kbmMWNativeHTTPClientTransport;

// by xalion

interface

{$I kbmMW.inc}


{.$define indyhttp}

{.$define httpsyslog}

uses
  Classes, Sysutils, kbmMWCustomTransport,kbmMWClient,

  {$ifdef indyhttp}

    idhttp,
  {$else}
     System.Net.HttpClientComponent,System.Net.HttpClient,
  {$endif}
  {$ifdef httpsyslog}
       kbmMWLog,
  {$endif}


  kbmMWGlobal;

type

{$IFDEF LEVEL16}
  [ComponentPlatformsAttribute({$IFDEF LEVEL23}pidiOSDevice64 or {$ENDIF}{$IFDEF LEVEL18}pidiOSSimulator or pidiOSDevice 

or {$ENDIF}{$IFDEF LEVEL19}pidAndroid or {$ENDIF}pidWin32 or pidWin64{$IFDEF LEVEL17} or pidOSX32{$ENDIF})]
{$ENDIF}
  TkbmMWNativeHTTPClientTransport = class(TkbmMWCustomClientTransport)
  private

     {$ifdef indyhttp}
        FHttpClient:Tidhttp;
    {$else}
       FHttpClient:TNetHTTPClient;
    {$endif}

    FTimeout:integer;
    MyRequestContent:TMemoryStream;
    fhost:string;
    fserverurl:string;
    fssl:boolean;
    Fversion:string;
    FClientType:string;

   public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;

    class function IsSerializedTransport:boolean; override;
    class function IsConnectionlessTransport:boolean; override;

    procedure Connect; override;
    procedure Disconnect; override;
    procedure Assign(ATransport:TPersistent); override;
    function ReceiveStream(AInfo:IkbmMWCustomTransportInfo; const AStream:IkbmMWCustomTransportStream; ALimit:integer):boolean; override;
    procedure TransmitStream(AInfo:IkbmMWCUstomTransportInfo; const AStream:IkbmMWCustomTransportStream); override;
    published
    property Host:string  read fhost write fhost;
    property ServerURL:string read fserverurl write fserverurl;
    property SSL:boolean  read fssl write fssl;
    Property ClientType:string read FClientType;
    Property  Version:string read Fversion;


    property Crypt ;
    property Compression ;
    property StreamFormat;
    property StringConversion;
    property Timeout:integer read FTimeout write FTimeout default 3000;
    property OnException;


    property OnConnectionLost;
    property OnReconnect;
    property MaxRetries;
    property MaxRetriesAlternative;
    property ConnectionString;
    property FallbackServers;
    property AutoFallback;
    property VerifyTransfer;


  end;
  {$I httpsysversion.inc}

 使用http.sys 的應用服務器比使用indy 的速度及穩定性都大大提高。

經過多個實際項目的使用，效果非常好。

總而言之，在windows 上，使用http.sys，就這么自信！

感謝無為、紅魚兒、清幽傲竹、努力的干等同學的支持及測試。