Componentes.Terceros.RemObjects/official/5.0.35.741/RemObjects SDK for Delphi/Source/uROIpSuperHttpServer.pas

unit uROIpSuperHttpServer;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Synapse Components                                }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

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);
    function GetDisableNagle: Boolean;
    procedure SetDisableNagle(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
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Port: Integer read GetPort write SetPort default 8099;
    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 DisableNagle: Boolean read GetDisableNagle write SetDisableNagle default true;

    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;
  fSocket.Port := 8099;
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;

function TROIpSuperHTTPServer.GetDisableNagle: Boolean;
begin
  result := fSocket.DisableNagle;
end;

procedure TROIpSuperHTTPServer.SetDisableNagle(const Value: Boolean);
begin
  fSocket.DisableNagle := Value;
end;

initialization
  RegisterServerClass(TROIpSuperHTTPServer);

finalization
  UnregisterServerClass(TROIpSuperHTTPServer);

end.