Componentes.Terceros.RemObjects/internal/6.0.43.801/1/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;
    procedure SetBindV4(const Value: Boolean);
    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);
    function GetPort: Integer;override;
    procedure SetPort(const Value: Integer);override;
    function GetServerType: TROServerType; override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Port 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.Assign(Source: TPersistent);
var
  lSource: TROIpSuperHTTPServer;
begin
  inherited;
  if Source is TROIpSuperHTTPServer then begin
    lSource := TROIpSuperHTTPServer(Source);

    BindV4 := lSource.BindV4;
    BindV6 := lSource.BindV6;
    DisableNagle := lSource.DisableNagle;
    OnManualBindSocket := lSource.OnManualBindSocket;
    OnUnknownRequest := lSource.OnUnknownRequest;
    ServerName := lSource.ServerName;
  end;
end;

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.GetServerType: TROServerType;
begin
  Result := rstSuperHTTP;
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.