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:2405414352@qq.com' + #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.