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.