david
e28ea786d9
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@61 b6239004-a887-0f4b-9937-50029ccdca16
293 lines
8.5 KiB
ObjectPascal
293 lines
8.5 KiB
ObjectPascal
unit uROOlympiaEventRepository;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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, SyncObjs, // Contnrs,
|
|
uROSessions, uROClientIntf, uROClient, uROTypes, uROClasses, uROServerIntf,
|
|
uROEventRepository, ROOlympia_Intf, uROBinMessage;
|
|
|
|
type
|
|
TROOlympiaEventRepository = class(TROInMemoryEventRepository, IROValidatedSessionsChangesListener,
|
|
IOlympiaEvents)
|
|
private
|
|
FActive: Boolean;
|
|
FChannel: TROTransportChannel;
|
|
FEventReceiver: TROEventReceiver;
|
|
FUsername: string;
|
|
FPassword: string;
|
|
function GetOlympiaInstance(out aMsg: IROMessage): IOlympia;
|
|
procedure SetActive(const Value: Boolean);
|
|
protected
|
|
procedure DoAddSession(aSessionID: TGUID;
|
|
aActiveEventServer: IROActiveEventServer); override;
|
|
|
|
function DoGetEventData(SessionID: TGUID;
|
|
var TargetStream: TROBinaryMemoryStream): Integer; override;
|
|
procedure DoRemoveSession(aSessionID: TGUID); override;
|
|
procedure DoStoreEventData(SourceSessionID: TGUID;
|
|
Data: TROBinaryMemoryStream; const ExcludeSender: Boolean;
|
|
const ExcludeSessionList: Boolean; const SessionList: String);
|
|
override;
|
|
procedure EventSucceeded(aClientID: TGUID; aId: TGUID);
|
|
procedure HaveMessage(const Targets: GuidArray; const EventID: Guid;
|
|
const Data: TROBinaryMemoryStream);
|
|
procedure Loaded; override;
|
|
procedure Login;
|
|
procedure Logout;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
|
override;
|
|
procedure RemoveSessionActiveListener(Sender: TObject;
|
|
aSessionID: TGUID); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CheckProperties; override;
|
|
|
|
property Username: string read FUsername write FUsername;
|
|
property Password: string read FPassword write FPassword;
|
|
property Channel: TROTransportChannel read fChannel write fChannel;
|
|
property Active: Boolean read FActive write SetActive;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TROOlympiaEventRepository }
|
|
|
|
procedure TROOlympiaEventRepository.CheckProperties;
|
|
begin
|
|
inherited;
|
|
Check(Channel = nil, 'Channel not assigned');
|
|
end;
|
|
|
|
constructor TROOlympiaEventRepository.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FEventReceiver := TROEventReceiver.Create(self);
|
|
FEventReceiver.Message := TROBinMessage.Create(self);
|
|
end;
|
|
|
|
destructor TROOlympiaEventRepository.Destroy;
|
|
begin
|
|
FEventReceiver.Deactivate;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.DoAddSession(aSessionID: TGUID;
|
|
aActiveEventServer: IROActiveEventServer);
|
|
var
|
|
lOlympia: IOlympia;
|
|
lArr: GuidArray;
|
|
lMsg: IROMessage;
|
|
begin
|
|
inherited;
|
|
if aActiveEventServer = nil then exit;
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
lArr := GuidArray.Create;
|
|
try
|
|
lArr.Add(GUIDToString(aSessionID));
|
|
lOlympia.RegisterActiveEvents(lArr);
|
|
finally
|
|
lArr.Free;
|
|
end;
|
|
lMsg := nil;
|
|
end;
|
|
|
|
function TROOlympiaEventRepository.DoGetEventData(SessionID: TGUID;
|
|
var TargetStream: TROBinaryMemoryStream): Integer;
|
|
var
|
|
lOlympia: IOlympia;
|
|
lMsg: IROMessage;
|
|
begin
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
Result := lOlympia.GetMessages(GUIDToAnsiString(SessionID), TargetStream);
|
|
lMsg := nil;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.DoRemoveSession(aSessionID: TGUID);
|
|
var
|
|
lOlympia: IOlympia;
|
|
lArr: GuidArray;
|
|
lMsg: IROMessage;
|
|
begin
|
|
inherited;
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
lArr := GuidArray.Create;
|
|
try
|
|
lArr.Add(GUIDToString(aSessionID));
|
|
lOlympia.UnregisterActiveEvents(lArr);
|
|
finally
|
|
lArr.Free;
|
|
end;
|
|
lMsg := nil;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.DoStoreEventData(
|
|
SourceSessionID: TGUID; Data: TROBinaryMemoryStream; const ExcludeSender,
|
|
ExcludeSessionList: Boolean; const SessionList: String);
|
|
var
|
|
lOlympia: IOlympia;
|
|
lTargets: GuidArray;
|
|
lList: TStringList;
|
|
lMsg: IROMessage;
|
|
i: Integer;
|
|
begin
|
|
lTargets := nil;
|
|
if SessionList <> '' then begin
|
|
lList := TStringList.Create;
|
|
try
|
|
llist.Sorted := TRUE;
|
|
llist.Duplicates := dupIgnore;
|
|
llist.CommaText := SessionList;
|
|
for i := 0 to lList.Count -1 do begin
|
|
if lList[i] <> '' then begin
|
|
if lTargets = nil then lTargets := GuidArray.Create;
|
|
lTArgets.Add(lList[i]);
|
|
end;
|
|
end;
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
end;
|
|
try
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
if lTargets <> nil then
|
|
lOlympia.StoreMessageEx(GUIDToString(SourceSessionID), lTargets, Data)
|
|
else
|
|
lOlympia.StoreMessage(GUIDToAnsiString(SourceSessionID), Data);
|
|
lMsg := nil;
|
|
finally
|
|
lTargets.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.EventSucceeded(aClientID, aId: TGUID);
|
|
var
|
|
lOlympia: IOlympia;
|
|
lMsg: IROMessage;
|
|
lArr: GuidArray;
|
|
begin
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
lArr := GuidArray.Create;
|
|
try
|
|
lArr.Add(GUIDToString(aId));
|
|
lOlympia.RemoveEventMessage(GUIDToString(aClientID), lArr);
|
|
finally
|
|
lArr.Free;
|
|
end;
|
|
lMsg := nil;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.HaveMessage(const Targets: GuidArray;
|
|
const EventID: Guid; const Data: TROBinaryMemoryStream);
|
|
var
|
|
ev: TRONamedEventData;
|
|
lRef: TROSessionReference;
|
|
i: Integer;
|
|
begin
|
|
ev := TRONamedEventData.Create(Data.Clone);
|
|
ev.ID := StringToGUID(EventID);
|
|
for i := 0 to Targets.Count -1 do begin
|
|
lRef := FindSession(StringToGUID(Targets[i]));
|
|
if assigned(lRef) and assigned(lREf.ActiveEventReference) then begin
|
|
ev.AddRef;
|
|
lRef.ActiveEventReference.DispatchEvent(ev, lRef.SessionID, self);
|
|
end;
|
|
end;
|
|
if ev.RemoveRef = 0 then ev.Free;
|
|
end;
|
|
|
|
function TROOlympiaEventRepository.GetOlympiaInstance(out aMsg: IROMessage): IOlympia;
|
|
begin
|
|
aMsg := (Message as IROMessageCloneable).Clone;
|
|
Result := CoOlympia.Create(aMsg, FChannel);
|
|
end;
|
|
|
|
|
|
procedure TROOlympiaEventRepository.Loaded;
|
|
begin
|
|
if Active then begin
|
|
FActive := false;
|
|
SetActive(true);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.SetActive(const Value: Boolean);
|
|
begin
|
|
if FActive = Value then exit;
|
|
FActive := Value;
|
|
CheckProperties;
|
|
if csDesigning in ComponentState then exit;
|
|
if FActive then begin
|
|
if IsEqualGUID(EmptyGUID, Message.ClientID) then Message.ClientID := NewGuid;
|
|
Login;
|
|
FEventReceiver.Channel := FChannel;
|
|
FEventReceiver.Message := Message;
|
|
FEventReceiver.SynchronizeInvoke := false;
|
|
FEventReceiver.ServiceName := 'Olympia';
|
|
FEventReceiver.ServersideRegisterEvents := false;
|
|
FEventReceiver.RegisterEventHandler('OlympiaEvents', self);
|
|
FEventReceiver.Activate;
|
|
end else begin
|
|
Logout;
|
|
FEventReceiver.UnregisterEventHandler('OlympiaEvents');
|
|
FEventReceiver.Deactivate;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Login;
|
|
var
|
|
lOlympia: IOlympia;
|
|
lMsg: IROMessage;
|
|
begin
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
if fUsername = '' then begin
|
|
lOlympia.GetTimeout; // Just activate the server channel
|
|
end else
|
|
lOlympia.Login(Username, Password);
|
|
lMsg := nil;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Logout;
|
|
var
|
|
lOlympia: IOlympia;
|
|
lMsg: IROMessage;
|
|
begin
|
|
lOlympia := GetOlympiaInstance(lMsg);
|
|
lOlympia.Logout;
|
|
lMsg := nil;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (Operation = opRemove) and (AComponent = FChannel) Then begin
|
|
Active := false;
|
|
fChannel := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.RemoveSessionActiveListener(Sender: TObject; aSessionID: TGUID);
|
|
begin
|
|
inherited;
|
|
DoRemoveSession(aSEssionID);
|
|
end;
|
|
|
|
end.
|