Componentes.Terceros.RemObjects/official/5.0.23.613/RemObjects SDK for Delphi/Source/uRORemoteService.pas

unit uRORemoteService;

{----------------------------------------------------------------------------}
{ 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, SysUtils,
  uROTypes, uROClasses, uROClient, uROClientIntf, uRODL;

type
  { TRORemoteService }
  TRORemoteService = class(TROComponent)
  private
    fMessage: TROMessage;
    fChannel: TROTransportChannel;
    fRodlLibrary: TRODLLibrary;
    fCacheRODL: boolean;
    fServiceName: string;

    procedure SetServiceName(const Value: string);
    procedure SetCacheRODL(const Value: boolean);
    procedure SetChannel(const Value: TROTransportChannel);
    procedure SetMessage(const Value: TROMessage);

    {$IFDEF DESIGNTIME}
    procedure FixUpTargetURL;
    {$ENDIF}

  protected
    // Internals
    procedure Notification(aComponent: TComponent; Operation: TOperation); override;
    function QueryInterface(const IID: TGUID; out Obj): HResult; override;

  public
    destructor Destroy; override;

    function GetRODLLibrary : TRODLLibrary; virtual;
    function GetServiceNames(aIncludeAbstractServices:boolean=false): IROStrings;
    function GetServiceMethods: IROStrings; virtual;

    procedure CheckCanConnect(CheckServiceName: boolean = true);
    procedure CheckProperties;

  published
    property Message : TROMessage read fMessage write SetMessage;
    property Channel : TROTransportChannel read fChannel write SetChannel;
    property ServiceName : string read fServiceName write SetServiceName;

    property CacheRODL: boolean read fCacheRODL write SetCacheRODL default false;
  end;

implementation

uses TypInfo, uRORes;

{ TRORemoteService }
destructor TRORemoteService.Destroy;
begin
  FreeAndNil(fRodlLibrary);
  inherited;
end;

procedure TRORemoteService.CheckCanConnect(CheckServiceName : boolean = TRUE);
begin
  Check(Channel=NIL, Name+'.Channel must be assigned.');
  Channel.CheckProperties;
  Check(Message=NIL, Name+'.Message must be assigned.');
  Message.CheckProperties;
  if CheckServiceName then Check(ServiceName='', Name+'.ServiceName must be specified.');
end;

procedure TRORemoteService.CheckProperties;
begin
  CheckCanConnect(true);
end;

procedure TRORemoteService.Notification(aComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) then begin
    if (aComponent=fChannel) then fChannel := NIL
    else if (aComponent=fMessage) then fMessage := NIL
  end;
end;

{$IFDEF DESIGNTIME}
procedure TRORemoteService.FixUpTargetURL;
var http : IROHTTPTransport;
    protocol : string;
begin
  if (fChannel<>NIL) and (fMessage<>NIL) then begin
    if Supports(fChannel, IROHTTPTransport, http) then
      if (http.TargetURL='') then begin
        protocol := UpperCase(StringReplace(Copy(fMessage.ClassName, 4, MaxInt), 'Message', '', [rfIgnoreCase]));
        http.TargetURL := 'http://localhost:8099/'+protocol;
      end;
    end;
end;
{$ENDIF}

procedure TRORemoteService.SetChannel(const Value: TROTransportChannel);
begin
  fChannel := Value;
  if (fChannel<>NIL) then begin
    fChannel.FreeNotification(Self);
    {$IFDEF DESIGNTIME}
    if (csDesigning in ComponentState) then FixUpTargetURL;
    {$ENDIF}
  end;
end;

procedure TRORemoteService.SetMessage(const Value: TROMessage);
begin
  fMessage := Value;
  if (fMessage<>NIL) then begin
    fMessage.FreeNotification(Self);
    {$IFDEF DESIGNTIME}
    if (csDesigning in ComponentState) then FixUpTargetURL;
    {$ENDIF}
  end;
end;

{$IFDEF DELPHI5}
const S_OK = 0;
{$ENDIF}

function TRORemoteService.QueryInterface(const IID: TGUID; out Obj): HResult;
var //ref : IInterface;
    proxyclass : TROProxyClass;
    proxy : TROProxy;
begin
  result := inherited QueryInterface(IID, Obj);

  if (result <> S_OK) then begin
    proxyclass := FindProxyClass(IID, TRUE);

    if (proxyclass=NIL) then Exit
    else begin
      proxy := proxyclass.Create(fMessage, fChannel);
      proxy.GetInterface(IID, Obj);
      result := S_OK;
    end;
  end;
end;

procedure TRORemoteService.SetCacheRODL(const Value: boolean);
begin
  fCacheRODL := Value;
  if not fCacheRODL then
    FreeAndNil(fRodlLibrary)
end;

function TRORemoteService.GetRODLLibrary: TRODLLibrary;
var
  lMetadataReader:IROMetadataReader;
begin
  if fCacheRODL and assigned(fRodlLibrary) then begin
    result := fRodlLibrary;
    exit;
  end;

  FreeAndNil(fRodlLibrary);
  CheckCanConnect(False);
//  if not Assigned(Channel) then raise EROUserError.Create(err_CannotReadRODLWithoutChannel);

  if Supports(Channel,IROMetadataReader,lMetadataReader) then begin
    lMetadataReader.RetrieveRODL(fRodlLibrary);
    result := fRodlLibrary;
  end
  else begin
    raise Exception.Create(err_ChannelDoesntSupportIROMetadataReader);
  end;
end;

function TRORemoteService.GetServiceNames(aIncludeAbstractServices:boolean=false): IROStrings;
var
  lib : TRODLLibrary;
  i : integer;
begin
  CheckCanConnect(FALSE);

  result := NIL;
  lib := GetRODLLibrary;
  if Assigned(lib) then begin
    result := NewROStrings;

    for i := 0 to (lib.ServiceCount-1) do
      if not lib.Services[i].IsFromUsedRodl then
        if aIncludeAbstractServices or (not lib.Services[i].Abstract) then
          result.Add(lib.Services[i].Info.Name);
  end;
end;

procedure TRORemoteService.SetServiceName(const Value: string);
begin
  fServiceName := Trim(Value);
end;

function TRORemoteService.GetServiceMethods:IROStrings;
var
  lLibrary: TRODLLibrary;
  lService: TRODLService;
  i:integer;
begin
  lLibrary := GetRODLLibrary();
  if not Assigned (lLibrary) then RaiseError('Library could not retrieved from server');
  result := NewROStrings;

  lService := lLibrary.FindService(ServiceName);
  if not Assigned (lService) then RaiseError('Service "%s" not found in library');

  while Assigned(lService) do begin
    for i := 0 to lService.Default.Count-1 do begin
      result.Add(lService.Default.Items[i].Info.Name);
    end; { for }
    if (lService.Ancestor <> '') then begin
      lService := lLibrary.FindService(lService.Ancestor);
    end
    else begin
      lService := nil;
    end;
  end;
  (result.Strings as TStringList).Sort();
end;

end.