david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
335 lines
10 KiB
ObjectPascal
335 lines
10 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,
|
|
uROSessions, uROClientIntf, uROClient, uROTypes, uROClasses, uROServerIntf,
|
|
uROEventRepository, ROOlympia_Intf, uROBinMessage, uROOlympiaSessionManager;
|
|
|
|
type
|
|
TROOlympiaEventRepository = class(TROInMemoryEventRepository, IROValidatedSessionsChangesListener,
|
|
IOlympiaEvents)
|
|
private
|
|
FActive: Boolean;
|
|
FUsername: string;
|
|
FPassword: string;
|
|
fStreamedActive: Boolean;
|
|
function GetOlympiaInstance: IOlympia;
|
|
procedure SetActive(const Value: Boolean);
|
|
function GetSessionManager: TROOlympiaSessionManager;
|
|
procedure SetSessionManager(const Value: TROOlympiaSessionManager);reintroduce;
|
|
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: AnsiString;
|
|
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 Active: Boolean read FActive write SetActive;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property SessionManager: TROOlympiaSessionManager read GetSessionManager write SetSessionManager;
|
|
property Password: string read FPassword write FPassword;
|
|
property Username: string read FUsername write FUsername;
|
|
end;
|
|
|
|
implementation
|
|
{ TROOlympiaEventRepository }
|
|
|
|
procedure TROOlympiaEventRepository.Assign(Source: TPersistent);
|
|
var
|
|
lSource: TROOlympiaEventRepository;
|
|
begin
|
|
inherited;
|
|
if Source is TROOlympiaEventRepository then begin
|
|
lSource := TROOlympiaEventRepository(Source);
|
|
|
|
Password := lSource.Password;
|
|
Username := lSource.Username;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.CheckProperties;
|
|
begin
|
|
inherited;
|
|
Check(not Assigned(SessionManager),'%s: SessionManager must be assigned.',[Self.Name]);
|
|
SessionManager.CheckProperties;
|
|
end;
|
|
|
|
constructor TROOlympiaEventRepository.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
destructor TROOlympiaEventRepository.Destroy;
|
|
begin
|
|
if FActive then Active :=False;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.DoAddSession(aSessionID: TGUID;
|
|
aActiveEventServer: IROActiveEventServer);
|
|
var
|
|
lArr: GuidArray;
|
|
begin
|
|
inherited;
|
|
if aActiveEventServer = nil then exit;
|
|
lArr := GuidArray.Create;
|
|
try
|
|
lArr.Add(GUIDToString(aSessionID));
|
|
GetOlympiaInstance.RegisterActiveEvents(lArr);
|
|
finally
|
|
lArr.Free;
|
|
end;
|
|
end;
|
|
|
|
function TROOlympiaEventRepository.DoGetEventData(SessionID: TGUID;
|
|
var TargetStream: TROBinaryMemoryStream): Integer;
|
|
begin
|
|
FreeandNil(TargetStream);
|
|
Result := GetOlympiaInstance.GetMessages(GUIDToAnsiString(SessionID), TargetStream);
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.DoRemoveSession(aSessionID: TGUID);
|
|
var
|
|
lArr: GuidArray;
|
|
begin
|
|
inherited;
|
|
lArr := GuidArray.Create;
|
|
try
|
|
lArr.Add(GUIDToString(aSessionID));
|
|
GetOlympiaInstance.UnregisterActiveEvents(lArr);
|
|
finally
|
|
lArr.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.DoStoreEventData(
|
|
SourceSessionID: TGUID; Data: TROBinaryMemoryStream; const ExcludeSender,
|
|
ExcludeSessionList: Boolean; const SessionList: String);
|
|
|
|
|
|
procedure RemoveSessionFromTargetList(AList: TStringList; ASessionID:string);
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := AList.IndexOf(ASessionID);
|
|
if i <> -1 then AList.Delete(i);
|
|
end;
|
|
|
|
function GetTargetSessionList: TStringList;
|
|
var
|
|
lList: TStringList;
|
|
begin
|
|
Result := TStringList.Create;
|
|
Result.Duplicates := dupIgnore;
|
|
if (ExcludeSessionList and (Trim(SessionList) <> '')) then begin
|
|
SessionManager.GetAllSessions(Result);
|
|
Result.Sorted := True;
|
|
lList := TStringList.Create;
|
|
try
|
|
lList.Sorted := TRUE;
|
|
lList.Duplicates := dupIgnore;
|
|
lList.CommaText := SessionList;
|
|
while llist.Count > 0 do begin
|
|
RemoveSessionFromTargetList(Result, lList[lList.Count-1]);
|
|
lList.Delete(lList.Count-1);
|
|
end;
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
end
|
|
else begin
|
|
if Trim(SessionList) = '' then
|
|
SessionManager.GetAllSessions(Result)
|
|
else
|
|
Result.CommaText := SessionList;
|
|
Result.Sorted := True;
|
|
end;
|
|
if ExcludeSender then RemoveSessionFromTargetList(Result, GUIDToString(SourceSessionID));
|
|
end;
|
|
|
|
var
|
|
lTargets: GuidArray;
|
|
lList: TStringList;
|
|
i: Integer;
|
|
begin
|
|
lTargets := nil;
|
|
if (SessionList <> '') or ExcludeSender then begin
|
|
lList := GetTargetSessionList;
|
|
try
|
|
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
|
|
if lTargets <> nil then
|
|
GetOlympiaInstance.StoreMessageEx(GUIDToAnsiString(SourceSessionID), lTargets, Data)
|
|
else
|
|
GetOlympiaInstance.StoreMessage(GUIDToAnsiString(SourceSessionID), Data);
|
|
finally
|
|
lTargets.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.EventSucceeded(aClientID, aId: TGUID);
|
|
var
|
|
lArr: GuidArray;
|
|
begin
|
|
lArr := GuidArray.Create;
|
|
try
|
|
lArr.Add(GUIDToString(aId));
|
|
GetOlympiaInstance.RemoveEventMessage(GUIDToAnsiString(aClientID), lArr);
|
|
finally
|
|
lArr.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.HaveMessage(const Targets: GuidArray;
|
|
const EventID: AnsiString; const Data: TROBinaryMemoryStream);
|
|
var
|
|
ev: TRONamedEventData;
|
|
lRef: TROSessionReference;
|
|
i: Integer;
|
|
lEventID: AnsiString;
|
|
begin
|
|
ev := TRONamedEventData.Create(Data);
|
|
if Length(EventID) = 36 then lEventID := '{'+EventID + '}' else lEventID := EventID;
|
|
|
|
ev.ID := StringToGUID({$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(lEventID));
|
|
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;
|
|
|
|
type
|
|
TMyROOlympiaSessionManager = class(TROOlympiaSessionManager)
|
|
|
|
end;
|
|
|
|
function TROOlympiaEventRepository.GetOlympiaInstance: IOlympia;
|
|
begin
|
|
CheckProperties;
|
|
Supports(TMyROOlympiaSessionManager(SessionManager).SessionManager, IOlympia, Result);
|
|
end;
|
|
|
|
|
|
function TROOlympiaEventRepository.GetSessionManager: TROOlympiaSessionManager;
|
|
begin
|
|
if inherited SessionManager is TROOlympiaSessionManager then begin
|
|
Result := TROOlympiaSessionManager(inherited SessionManager)
|
|
end
|
|
else begin
|
|
SessionManager := nil;
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Loaded;
|
|
begin
|
|
inherited;
|
|
if fStreamedActive then Active:=True;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.SetActive(const Value: Boolean);
|
|
begin
|
|
if (csLoading in ComponentState) then begin
|
|
fStreamedActive := Value
|
|
end
|
|
else begin
|
|
if FActive = Value then exit;
|
|
FActive := Value;
|
|
if csDesigning in ComponentState then exit;
|
|
if FActive then begin
|
|
CheckProperties;
|
|
if IsEqualGUID(EmptyGUID, Message.ClientID) then Message.ClientID := NewGuid;
|
|
Login;
|
|
SessionManager.Active := True;
|
|
TMyROOlympiaSessionManager(SessionManager).EventReceiver.RegisterEventHandler('OlympiaEvents', self);
|
|
TMyROOlympiaSessionManager(SessionManager).EventReceiver.Activate;
|
|
end else begin
|
|
TMyROOlympiaSessionManager(SessionManager).EventReceiver.UnregisterEventHandler('OlympiaEvents');
|
|
Logout;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.SetSessionManager(
|
|
const Value: TROOlympiaSessionManager);
|
|
begin
|
|
if inherited SessionManager <> Value then begin
|
|
if SessionManager <> nil then TMyROOlympiaSessionManager(SessionManager).EventReceiver.RORemoveFreeNotification(Self);
|
|
inherited SessionManager := Value;
|
|
if Value <> nil then TMyROOlympiaSessionManager(Value).EventReceiver.ROFreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Login;
|
|
begin
|
|
if fUsername = '' then
|
|
GetOlympiaInstance.GetTimeout // Just activate the server channel
|
|
else
|
|
GetOlympiaInstance.Login(Username, Password);
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Logout;
|
|
begin
|
|
GetOlympiaInstance.Logout;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
if (Operation = opRemove) and (AComponent = SessionManager) and FActive then SetActive(False);
|
|
if (Operation = opRemove) and (AComponent = Message) and FActive then SetActive(False);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROOlympiaEventRepository.RemoveSessionActiveListener(Sender: TObject; aSessionID: TGUID);
|
|
begin
|
|
inherited;
|
|
DoRemoveSession(aSEssionID);
|
|
end;
|
|
|
|
end.
|