首页 > 其他分享 >TIdHTTPWebBrokerBridge替换成mormot底层

TIdHTTPWebBrokerBridge替换成mormot底层

时间：2023-03-29 18:57:26浏览次数：66  
标签：function begin end 替换成 class mormot THorseProvider const TIdHTTPWebBrokerBridge

目前使用案例是git开源项目horse改动

思路大概为http请求被WebBrokerDispatch函数转发到了WebModule中进行后续处理。

替换如下单元源码即可将horse项目的indy底层改成mormot底层，修改原理来源http://bbs.2ccc.com/topic.asp?topicid=548153



unit Horse.Provider.Console;

interface

{$IF NOT DEFINED(FPC)}
uses
  Horse.Provider.Abstract,
  Horse.Constants,
  SynCrtSock,SynWebEnv,SynWebReqRes, Web.WebReq,
  System.Classes,
  System.SyncObjs,
  System.SysUtils;

type
  THorseWebRequestHandler = class(TWebRequestHandler);
  THorseProvider = class(THorseProviderAbstract)
  private
    class var FPort: Integer;
    class var FHost: string;
    class var FRunning: Boolean;
    class var FEvent: TEvent;
    class var FMaxConnections: Integer;
    class var FListenQueue: Integer;
    class var FKeepConnectionAlive: Boolean;
    class var FIdHTTPWebBrokerBridge: THttpApiServer;
    class var FReqHandler: TWebRequestHandler;
    class function GetDefaultHTTPWebBroker: THttpApiServer;
    class function GetDefaultEvent: TEvent;
    class function HTTPWebBrokerIsNil: Boolean;

    class procedure SetListenQueue(const AValue: Integer); static;
    class procedure SetMaxConnections(const AValue: Integer); static;
    class procedure SetPort(const AValue: Integer); static;
    class procedure SetHost(const AValue: string); static;
    class procedure SetKeepConnectionAlive(const AValue: Boolean); static;
    class function GetListenQueue: Integer; static;
    class function GetMaxConnections: Integer; static;
    class function GetPort: Integer; static;
    class function GetDefaultPort: Integer; static;
    class function GetDefaultHost: string; static;
    class function GetHost: string; static;
    class function GetKeepConnectionAlive: Boolean; static;
    class procedure InternalListen; virtual;
    class procedure InternalStopListen; virtual;
    class function Process(AContext: THttpServerRequest): cardinal;
    class function WebBrokerDispatch(const AEnv: TSynWebEnv): Boolean;
  public
    class property Host: string read GetHost write SetHost;
    class property Port: Integer read GetPort write SetPort;
    class property MaxConnections: Integer read GetMaxConnections write SetMaxConnections;
    class property ListenQueue: Integer read GetListenQueue write SetListenQueue;
    class property KeepConnectionAlive: Boolean read GetKeepConnectionAlive write SetKeepConnectionAlive;
    class procedure StopListen; override;
    class procedure Listen; overload; override;
    class procedure Listen(const APort: Integer; const AHost: string = '0.0.0.0'; const ACallbackListen: TProc = nil; const ACallbackStopListen: TProc = nil); reintroduce; overload; static;
    class procedure Listen(const APort: Integer; const ACallbackListen: TProc; const ACallbackStopListen: TProc = nil); reintroduce; overload; static;
    class procedure Listen(const AHost: string; const ACallbackListen: TProc = nil; const ACallbackStopListen: TProc = nil); reintroduce; overload; static;
    class procedure Listen(const ACallbackListen: TProc; const ACallbackStopListen: TProc = nil); reintroduce; overload; static;
    class function IsRunning: Boolean;
    class destructor UnInitialize;
  end;
{$ENDIF}

implementation

{$IF NOT DEFINED(FPC)}
uses

  Horse.WebModule;
var
  RequestHandler: TWebRequestHandler = nil;

function GetRequestHandler: TWebRequestHandler;
begin
  if RequestHandler = nil then
    RequestHandler := THorseWebRequestHandler.Create(nil);
  Result := RequestHandler;
end;

class function THorseProvider.GetDefaultHTTPWebBroker: THttpApiServer;
begin
  if HTTPWebBrokerIsNil then
  begin
    FIdHTTPWebBrokerBridge := THttpApiServer.Create(False);
  end;
  FReqHandler := GetRequestHandler;
  Result := FIdHTTPWebBrokerBridge;
end;

class function THorseProvider.HTTPWebBrokerIsNil: Boolean;
begin
  Result := FIdHTTPWebBrokerBridge = nil;
end;


class function THorseProvider.GetDefaultEvent: TEvent;
begin
  if FEvent = nil then
    FEvent := TEvent.Create;
  Result := FEvent;
end;


class function THorseProvider.GetDefaultHost: string;
begin
  Result := DEFAULT_HOST;
end;

class function THorseProvider.GetDefaultPort: Integer;
begin
  Result := DEFAULT_PORT;
end;

class function THorseProvider.GetHost: string;
begin
  Result := FHost;
end;

class function THorseProvider.GetKeepConnectionAlive: Boolean;
begin
  Result := FKeepConnectionAlive;
end;

class function THorseProvider.IsRunning: Boolean;
begin
  Result := FRunning;
end;


class function THorseProvider.GetListenQueue: Integer;
begin
  Result := FListenQueue;
end;

class function THorseProvider.GetMaxConnections: Integer;
begin
  Result := FMaxConnections;
end;

class function THorseProvider.GetPort: Integer;
begin
  Result := FPort;
end;

class function THorseProvider.Process(AContext: THttpServerRequest): cardinal;
var
  FEnv: TSynWebEnv;
  Log: string;
begin
  try
    try
      FEnv := TSynWebEnv.Create(AContext);
      try
        if WebBrokerDispatch(FEnv) then
          Result := 200
        else
          Result := 404;
      finally
        Freeandnil(FEnv);
      end;
    except
      on e: Exception do
      begin
        AContext.OutContent := '服务器运行出错:'
          + AContext.Method + '-' + AContext.URL + '：' + e.Message;
        Result := 500;
      end;
    end;
  finally
    AContext.OutCustomHeaders := 'Developer:[email protected]' + #13#10 +
      'Development:YanHua Medical' ;

  end;
end;

class function THorseProvider.WebBrokerDispatch(const AEnv: TSynWebEnv): Boolean;
var
  HTTPRequest: TSynWebRequest;
  HTTPResponse: TSynWebResponse;
begin
  HTTPRequest := TSynWebRequest.Create(AEnv);
  try
    HTTPResponse := TSynWebResponse.Create(HTTPRequest);
    try
      Result := THorseWebRequestHandler(FReqHandler).HandleRequest(HTTPRequest,
        HTTPResponse);
    finally
      freeandnil(HTTPResponse);
    end;
  finally
    freeandnil(HTTPRequest);
  end;
end;



class procedure THorseProvider.InternalListen;
var
  LAttach: string;
  LIdHTTPWebBrokerBridge: THttpApiServer;
begin
  inherited;
  if FPort <= 0 then
    FPort := GetDefaultPort;

  if FHost.IsEmpty then
    FHost := GetDefaultHost;

  LIdHTTPWebBrokerBridge := GetDefaultHTTPWebBroker;
  FReqHandler.WebModuleClass := WebModuleClass;
  //FMaxConnections := 1000;
  try
    if FMaxConnections > 0 then
    begin
      FReqHandler.MaxConnections := FMaxConnections;
      GetDefaultHTTPWebBroker.MaxConnections := FMaxConnections;
    end;
    LIdHTTPWebBrokerBridge.AddUrl('', FPort.ToString, false, '+', true);

    LIdHTTPWebBrokerBridge.OnRequest := Process;
    //LIdHTTPWebBrokerBridge.HTTPQueueLength := 10000;
    LIdHTTPWebBrokerBridge.Clone(32 - 1); // will use a thread pool of 32 threads in total

    FRunning := True;
    DoOnListen;

    if IsConsole then
    begin
      while FRunning do
        GetDefaultEvent.WaitFor();
    end
  except
    on E: Exception do
    begin
      if IsConsole then
      begin
        Writeln(E.ClassName, ': ', E.Message);
        Read(LAttach);
      end
      else
{$IF CompilerVersion >= 32.0}
        raise AcquireExceptionObject;
{$ELSE}
        raise;
{$ENDIF}
    end;
  end;
end;

class procedure THorseProvider.InternalStopListen;
begin
  if not HTTPWebBrokerIsNil then
  begin
    GetDefaultHTTPWebBroker.RemoveUrl('', FPort.ToString, false, '+');
    DoOnStopListen;
    FRunning := False;
    if FEvent <> nil then
      GetDefaultEvent.SetEvent;
  end
  else
    raise Exception.Create('Horse not listen');
end;

class procedure THorseProvider.StopListen;
begin
  InternalStopListen;
end;

class procedure THorseProvider.Listen;
begin
  InternalListen;
end;

class procedure THorseProvider.Listen(const APort: Integer; const AHost: string; const ACallbackListen, ACallbackStopListen: TProc);
begin
  SetPort(APort);
  SetHost(AHost);
  SetOnListen(ACallbackListen);
  SetOnStopListen(ACallbackStopListen);
  InternalListen;
end;

class procedure THorseProvider.Listen(const AHost: string; const ACallbackListen, ACallbackStopListen: TProc);
begin
  Listen(FPort, AHost, ACallbackListen, ACallbackStopListen);
end;

class procedure THorseProvider.Listen(const ACallbackListen, ACallbackStopListen: TProc);
begin
  Listen(FPort, FHost, ACallbackListen, ACallbackStopListen);
end;

class procedure THorseProvider.Listen(const APort: Integer; const ACallbackListen, ACallbackStopListen: TProc);
begin
  Listen(APort, FHost, ACallbackListen, ACallbackStopListen);
end;

class procedure THorseProvider.SetHost(const AValue: string);
begin
  FHost := AValue.Trim;
end;

class procedure THorseProvider.SetKeepConnectionAlive(const AValue: Boolean);
begin
  FKeepConnectionAlive := AValue;
end;


class procedure THorseProvider.SetListenQueue(const AValue: Integer);
begin
  FListenQueue := AValue;
end;

class procedure THorseProvider.SetMaxConnections(const AValue: Integer);
begin
  FMaxConnections := AValue;
end;

class procedure THorseProvider.SetPort(const AValue: Integer);
begin
  FPort := AValue;
end;

class destructor THorseProvider.UnInitialize;
begin
  FreeAndNil(FIdHTTPWebBrokerBridge);
  if FEvent <> nil then
    FreeAndNil(FEvent);
end;
{$ENDIF}

initialization
  Web.WebReq.WebRequestHandlerProc := GetRequestHandler;


finalization
  if RequestHandler <> nil then
    FreeAndNil(RequestHandler);

end.

标签：function,begin,end,替换成,class,mormot,THorseProvider,const,TIdHTTPWebBrokerBridge
From： https://www.cnblogs.com/Yang-YaChao/p/17269989.html

相关文章

  • 【算法】空格替换成20% （java实现）
    packagecom.billkang.algorithm;/***空格替换成20%*@authorKangbin*@date2018-11-17*/publicclassReplaceSpace{publicStringreplaceSpaces1(St......
  • mormot2事件驱动模型
    mormot2事件驱动模型异步套接字访问和事件循环是最佳服务器可伸缩性的关键。事件非常抽象，实际上只是每个连接上的基本R/W操作，与“tag”相关联。然后在这些基本的套接......
  • mormot2压力测试
    mormot2压力测试测试环境：inteli5-8400+8G内存+win115000个连接发出1千万次请求。   ......
  • 高铁（火车）采集：如何将一个标签值内的字符，替换成另一个标签的值？
    使用火车头采集数据的时候，比如采集图片，我们需要将标题，加入到图片元素的alt和title值内，方便帝国多图参数调用；如图：    已知前面的图片元素可以通过循环采集到，如何将......
  • mormot2 tls
    mormot2tlsmormot.net.sock.pasTNetTlsContext=record;典型用法withTHttpClientSocket.CreatedotryTLS.WithPeerInfo:=true;TLS.IgnoreCertificate......
  • php中preg_replace_callback函数同一个正则，替换成不同内容
    可以使用php在线运行，去运行文章的代码https://www.bejson.com/runcode/php/本文实例讲述了php中preg_replace_callback函数用法。分享给大家供大家参考，具体如下：mixedpr......
  • mormot2.binary.serial.pas
    mormot2.binary.serial.pasunitmormot2.binary.serial;///<author>cxg2023-2-22</author>{$IFDEFfpc}{$MODEDELPHI}{$H+}{$ENDIF}interfaceusesmormot......
  • mormot2.json.serial
    unitmormot2.json.serial;///<author>cxg2023-2-11</author>{$IFDEFfpc}{$MODEDELPHI}{$H+}{$ENDIF}interfaceusesmormot.core.text,mormot.core.json......
  • mormot2 http路由
    mormot2http路由mormot.net.server.pas重写包括2部分：重写URL+重写HTTPMETHOD。如果你用过GO就会惊喜地发现它与GO的HTTP路由非常相似以及更加方便。///efficient......
  • mormot2中间件
    mormot2中间件中间件同一份pascal源码，同时支持在DELPHI和LAZARUS下面开发编译。 DELPHI编译目标平台WIN32,WIN64,LINUXINTEL64位CPU，主要是WINDOWS平台，因为DELPHI在W......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99