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

unit uROHTTPDispatch;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ 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.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses Classes, uROServer, uROClient, uROClientIntf;

type
  { TROHTTPDispatcher }
  TROHTTPDispatcher = class(TROMessageDispatcher)
  private
    fPathInfo: string;

    procedure SetPathInfo(const Value: string);

    function CleanPathInfo(const iPath:string):string;

  protected
    procedure SetMessage(const Value: TROMessage); override;

  public
    procedure Assign(Source: TPersistent); override;
    function CanHandleMessage(const aTransport: IROTransport; aRequeststream : TStream): boolean; override;

  published
    property PathInfo : string read fPathInfo write SetPathInfo;
  end;

  { TROHTTPDispatchers }
  TROHTTPMessageDispatchers = class(TROMessageDispatchers)
  private
  protected
    function GetSupportsMultipleDispatchers: boolean; override;
    function GetDispatcherClass : TROMessageDispatcherClass; override;

  public
    function GetDispatcherByPath(Path: string): TROHTTPDispatcher;
  end;

implementation

uses SysUtils;

{ TROHTTPMessageDispatchers }

function TROHTTPMessageDispatchers.GetDispatcherByPath(
  Path: string): TROHTTPDispatcher;
var
  i: Integer;
begin
  for i := Count -1 downto 0 do
  begin
    result := Items[i] as TROHTTPDispatcher;
    if CompareText(result.PathInfo, Path) = 0 then
      exit;
    if (Result.PathInfo <> '') and (Result.PathInfo[1] <> '/') and (CompareText('/'+result.PathInfo, Path) = 0) then
      exit;
  end;
  result := nil;
end;

function TROHTTPMessageDispatchers.GetDispatcherClass: TROMessageDispatcherClass;
begin
  result := TROHTTPDispatcher;
end;

function TROHTTPMessageDispatchers.GetSupportsMultipleDispatchers: boolean;
begin
  result := TRUE;
end;

{ TROHTTPDispatcher }

procedure TROHTTPDispatcher.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  if Source is TROHTTPDispatcher
    then PathInfo := TROHTTPDispatcher(Source).PathInfo;
end;

function TROHTTPDispatcher.CanHandleMessage(const aTransport: IROTransport;
  aRequeststream: TStream): boolean;
var http : IROHTTPTransport;
begin
  result := FALSE;
  if not Enabled or not Supports(aTransport, IROHTTPTransport, http)
    then Exit;

  //1.0.4: comparison made caseinsensitive; PreparedPathInfo will alraedy be lowercase. mh.
  //if (CompareText(http.PathInfo, PathInfo)=0) then result := TRUE;
  result := (CleanPathInfo(http.PathInfo) = CleanPathInfo(PathInfo));
end;

procedure TROHTTPDispatcher.SetMessage(const Value: TROMessage);
var s : string;
begin
  inherited;

  if (PathInfo='') and (Value<>NIL) then begin
    s := StringReplace(Value.ClassName, 'Message', '', []);
    s := StringReplace(s, 'TRO', '', []);

    PathInfo := s;
  end;
end;

function ExcludeTrailingForwardSlash(const S: string): string;
var lLength: Integer;
begin
  result := S;
  lLength := Length(result);
  if (result <> '') and (result[lLength] = '/') then SetLength(result,lLength-1);
end;

procedure TROHTTPDispatcher.SetPathInfo(const Value: string);
begin
  if Value <> fPathInfo then 
    fPathInfo := Value;
end;

function TROHTTPDispatcher.CleanPathInfo(const iPath:string):string;
begin
  result := iPath;

  if (Length(result)>0) and (result[1]<>'/') then result :='/'+result;

  // 1.0.4: make sure the path NEVER has a trailing slash
  StringReplace(result,'\','/',[rfReplaceAll]);
  result := ExcludeTrailingForwardSlash(result);

  result := LowerCase(result)
end;


end.