使用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.内核级的静态文件输出支持

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,就这么自信!

时间: 2024-10-11 22:54:38

使用http.sys,让delphi 的多层服务飞起来的相关文章

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

原delphi窑洞洞主xalion在自己的博客上发过一篇文章: <使用http.sys,让delphi 的多层服务飞起来> http://www.cnblogs.com/xalion/p/6219515.html 这里边提到如何把mormot的httpserver抠出来,嫁接到webbroker上,非常好的思路. 可惜xalion没贴出全部源代码. 最近对WebBroker做了点深入研究,给出了c5soft的实现,贴出全部源代码. 目前是0.0.0.1版本,仅搭了个框架,但是明眼人一看就明白实

使用http.sys,让delphi的多层服务真的飞起来【第二部】

这是本专题的续集,没读过第一部的看这里:http://bbs.2ccc.com/topic.asp?topicid=548153 之所以要搞第二部是因为第一部跟贴太多,读起来不方便,浪费大家的时间. 今天咱们聊的主题是:Delphi的DataSnap实质分析先说DataSnap中文应该翻译成什么,我个人的译法是:数据快照.大家不要被这么多介绍DataSnap的资料弄晕了,其实原理非常简单.要把DataSnap搞明白,必须先把客户端的TClientDataset控件搞明白,不会,找度娘.下面简称C

使用delphi 开发多层应用(二十四)KbmMW 的消息方式和创建WIB节点

KbmMW 中支持基于UDP的消息广播,也支持TCP/IP hub/spoke 方式,还有 基于UDP或者TCP/IP 的点对点的消息传输. 1.基于UDP的消息广播 根据UDP  的工作原理,在同一个网段里面,可以发布广播包.这样发布者只需要发布一次, 消息就可以被同一网段上的所有订阅者收到.这样大大的降低了网络带宽.这个方式的最大缺点是 无法直接跨越网段,如果要跨越网段,就需要建立一个Gateway. Gateway 就是一个程序,连接两个网段. 它接受第一个网段的广播消息,然后再广播到第二

使用delphi 开发多层应用(二十三)KbmMW 的WIB

解释WIB 是什么之前,先回顾以下我们前面的各种服务工作方式.前面的各种服务的工作方式都是请求/应答方式. 客户端发送请求,服务器端根据客户端的请求,返回相应的结果.这种方式是一种顺序式访问,是一种紧耦合的方式. 服务器被动接受访问,服务器无法直接给客户端发消息.针对这种情况出现了发布/订阅方式.现在这种方式很热呀! 发布/订阅方式类似出版社发行杂志,出版社每年要求大家订阅杂志,当你订阅后,每月到时,不管你有没有问, 杂志都会准时送到你家门口.对于计算机系统类似,当你订阅了服务器上的某种消息后,

在Delphi开发的服务中调用指定应用程序

原创作品,允许转载,转载时请务必以超链接形式标明文章 原始出处 .作者信息和本声明.否则将追究法律责任.http://fxh7622.blog.51cto.com/63841/529033 在很多时候,我们需要使用服务启动指定的应用程序来做到隐蔽启动程序的目的. 但是当我们直接使用Winexec来运行的时候,你会发现系统提示出错.以下的代码就是如何在Delphi编写的服务中启动指定的应用程序. function RunProcess(const ProcessName: String): Boo

使用delphi 开发多层应用(十六)使用XMLRPC 实现basic4android 远程调用RTC服务(讲述了RTC的特点,其底层通讯协议是自己封装SOCK 库,与kbmmw 的适合场合不完全一样)

    RealThinClient (以下简称RTC) 也是一款delphi 多层开发的框架,由于其底层通讯协议是自己封装SOCK 库,抛弃了 大家诟病的indy,因此表现的非常稳定,效率也非常高,深受很多人的追捧.由于RTC 是从底层通讯做起的,因此通讯层的 功能非常强,但是在中间层数据库功能虽然有所实现,但是没有kbmmw 和RO 强,但是对于普通的远程调用做的非常优雅. 同时它重点在于使用http 协议实现功能调用,因此与kbmmw 的适合场合不完全一样. 由于RTC 可以非常快速的建立

使用delphi 开发多层应用(二十二)使用kbmMW 的认证管理器

从kbmmw 4.4 开始,增加了认证管理器,这个比原来的简单认证提供了更多的功能.细化了很多权限操作. 今天对这一块做个介绍. 要做一个认证管理,大概分为以下5步: 1.  定义你要保护的资源,一般是服务.函数,当然你只要不限麻烦,可以是任何东西: 2.  定义使用者(用户): 3.  定义角色,使用者通过角色与服务器打交道: 4.  定义角色或用户可以访问的资源(授权): 5. 定义认证与登录的限制(本步不是必须的). 一般来说,用户是通过配置文件或数据库来保存的,这样可以灵活的设置用户名与

Win7/Vista/Server2008下VS 环境 调试调用 HTTP.SYS 无法启动监听服务及启动后其他机器无法访问端口

一. VS调试在Win7(vista系列)操作系统下 HttpListener无法绑定多个 指定IP.端口问题 来自:http://www.cnblogs.com/ryhan/p/4195693.html 现象:System.Net.HttpListenerException (0x80004005): 拒绝访问. 原因:VS IDE 权限不够(生成的产物权限也会不够),提升UAC权限即可解决 步骤: 1.选中对应Project,右键添加->新增应用程序清单文件 app.manifest 2.将

转(Delphi 新窑洞):使用delphi 开发多层应用(十七)使用RTC web 服务器返回JSON

RTC作为delphi 的最专业的web 应用服务器,如果客户端要使用JSON 的话,那么使用RTC 应该也是一种 非常好的选择.下面我们做一个使用RTC web 服务器返回数据库JSON 的例子. 建立一个新的程序窗体,放置如图的控件: 其中server 的属性为 注意,这一块先不要选多线程,因为在这个简单的例子里面暂时不涉及到数据库池, 后面我会做数据库池的例子. RtcDataProvider1 的属性 然后设置好unidac 的数据库连接属性,我这里使用Firebird 作为数据库. 并