Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROIpSuperHttpServer.pas

unit uROIpSuperHttpServer;

interface

{$I RemObjects.inc}

uses
 SysUtils, Classes, uIPAsyncSocket, uIPAsyncHttpServer, uROServer,
 uROBaseSuperHttpServer, uIPHttpHeaders;

const
  DefaultServerName = 'RemObjects SDK Super IpHttp Server for Delphi'; 

type
  TROIpSuperHttpServer = class(TROBaseSuperHttpServer)
  private
    fSocket: TIPAsyncHttpServer;
    fOnManualBindSocket: TNotifyEvent;
    fOnUnknownRequest: TIPAsyncHttpRequestHandler;
    fServerName: string;
    function GetBindV4: Boolean;
    function GetBindV6: Boolean;
    function GetPort: Integer;
    procedure SetBindV4(const Value: Boolean);
    procedure SetPort(const Value: Integer);
    procedure SetBindV6(const Value: Boolean);
  protected
    procedure CloseConnection(aConnection: IUnknown); override;
    function HandleUnknownRequest(aTarget: IUnknown; arequest: TIPHttpRequestHeaders; aData: TDynamicByteArray): Boolean; override;
    procedure SendResponse(aTarget: IUnknown; aHeaders: TIPHttpResponseHeaders; aData: TDynamicByteArray; UserData: IInterface);override;
    procedure SetDefaultHeaders(aTarget: IUnknown; aHeaders: TIPHttpResponseHeaders); override;
    procedure DoActivate; override;
    procedure DoDeactivate; override;
    procedure IntRequest(Sender: TObject; aContext: IIPAsyncContext);
    procedure IntBeforeCleanupContext(Sender: TObject; aContext: IIPAsyncContext);
    procedure IntResponseSent(Sender: TObject; aContext: IIPAsyncContext);
    procedure IntResponseFailed(Sender: TObject; aContext: IIPAsyncContext);
  public
  published
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    property Port: Integer read GetPort write SetPort default 80;
    property BindV6: Boolean read GetBindV6 write SetBindV6 default false;
    property BindV4: Boolean read GetBindV4 write SetBindV4 default true;
    property ServerName: string read fServerName write FserverName;

    property OnManualBindSocket: TNotifyEvent read fOnManualBindSocket write fOnManualBindSocket;
    property OnUnknownRequest: TIPAsyncHttpRequestHandler read fOnUnknownRequest write fOnUnknownRequest;
  end;

implementation

{ TROIpSuperHttpServer }

procedure TROIpSuperHttpServer.CloseConnection(aConnection: IUnknown);
begin
  IIPAsyncContext(aConnection).GetSelf.Disconnect;
end;

constructor TROIpSuperHttpServer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fSocket := TIPAsyncHttpServer.Create;
  fServerName := DefaultServerName;
  fSocket.OnRequest := IntRequest;
  fSocket.OnBeforeCleanupContext := IntBeforeCleanupContext;
  fSocket.OnResponseSent := IntResponseSent;
  fSocket.OnResponseFailed := IntResponseFailed;
end;

destructor TROIpSuperHttpServer.Destroy;
begin
  FreeAndNil(fSocket);
  inherited Destroy;
end;

procedure TROIpSuperHttpServer.DoActivate;
begin
  inherited DoActivate;
  fSocket.OnManualBind := fOnManualBindSocket;
  fSocket.MaxPostData := MaxPackageSize + 1024;
  fSocket.Active := true;
end;

procedure TROIpSuperHttpServer.DoDeactivate;
begin
  if FSocket <> nil  then fSocket.Active := false;
  inherited DoDeactivate;
end;

function TROIpSuperHttpServer.GetBindV4: Boolean;
begin
  result := fsocket.BindV4;
end;

function TROIpSuperHttpServer.GetBindV6: Boolean;
begin
  result := fsocket.BindV6;
end;

function TROIpSuperHttpServer.GetPort: Integer;
begin
  result := fSocket.Port;
end;

function TROIpSuperHttpServer.HandleUnknownRequest(aTarget: IUnknown;
  arequest: TIPHttpRequestHeaders; aData: TDynamicByteArray): Boolean;
begin
  if assigned(fOnUnknownRequest) then begin
    fOnUnknownRequest(self, IIPAsyncContext(aTarget));
    result := true;
  end else
    result := false;
end;

procedure TROIpSuperHttpServer.IntRequest(Sender: TObject;
  aContext: IIPAsyncContext);
begin
  HandleRequest(acontext, aContext.Request, aContext.RequestData);
end;


procedure TROIpSuperHttpServer.IntResponseFailed(Sender: TObject;
  aContext: IIPAsyncContext);
begin
  ResponseFailed(IUnknown(aContext.UserData));
end;

procedure TROIpSuperHttpServer.IntResponseSent(Sender: TObject;
  aContext: IIPAsyncContext);
begin
  ResponseSucessful(IUnknown(aContext.UserData));
end;

procedure TROIpSuperHttpServer.SendResponse(aTarget: IUnknown;
  aHeaders: TIPHttpResponseHeaders; aData: TDynamicByteArray;
  UserData: IInterface);
var
  p: Pointer;
  lTarget: IIPAsyncContext;
begin
  lTarget := IIPAsyncContext(aTarget);
  if aHeaders = nil then begin
    SetDefaultHeaders(aTarget, lTarget.Response);
    lTarget.Response.Headers.Values['Content-Type'] := 'application/octet-stream';
  end else
    lTarget.Response.Assign(aHeaders);
  lTarget.ResponseData := aDAta;
  p := nil;
  IUnknown(P) := UserData;
  lTarget.UserData := p;
  lTarget.SendResponse;
end;

procedure TROIpSuperHttpServer.IntBeforeCleanupContext(Sender: TObject;
  aContext: IIPAsyncContext);
var
  p: Pointer;
begin
  p := aContext.UserData;
  aContext.UserData := nil;
  IUnknown(P) := nil;
end;


procedure TROIpSuperHttpServer.SetBindV4(const Value: Boolean);
begin
  fSocket.BindV4 := VAlue;
end;

procedure TROIpSuperHttpServer.SetDefaultHeaders(aTarget: IUnknown;
  aHeaders: TIPHttpResponseHeaders);
begin
  aHeaders.Headers.Values['Server'] :=  fServerName;
end;

procedure TROIpSuperHttpServer.SetPort(const Value: Integer);
begin
  fSocket.Port := Value;
end;

procedure TROIpSuperHttpServer.SetBindV6(const Value: Boolean);
begin
  fSocket.BindV6 := Value;
end;

end.