使用http.sys，让delphi 的多层服务飞起来

Posted 2020-08-25 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，就这么自信！

感谢无为、红鱼儿、清幽傲竹、努力的干等同学的支持及测试。