662 lines
20 KiB
ObjectPascal
662 lines
20 KiB
ObjectPascal
|
unit HTTPChatLibrary_Intf;
|
||
|
|
|
||
|
|
{----------------------------------------------------------------------------}
|
||
|
|
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||
|
|
{ the RODL file associated with this project . }
|
||
|
|
{ }
|
||
|
|
{ Do not modify this unit manually, or your changes will be lost when this }
|
||
|
|
{ unit is regenerated the next time you compile the project. }
|
||
|
|
{----------------------------------------------------------------------------}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
{vcl:} Classes, TypInfo,
|
||
|
|
{RemObjects:} uROClasses, uROClient, uROTypes, uROClientIntf;
|
||
|
|
|
||
|
|
const
|
||
|
|
{ Library ID }
|
||
|
|
LibraryUID = '{FAC89BC0-FECD-410B-8A96-D03A60C8301B}';
|
||
|
|
|
||
|
|
{ Service Interface ID's }
|
||
|
|
IHTTPChatService_IID : TGUID = '{6893042C-3354-4AE6-B5FA-E7A637475C30}';
|
||
|
|
|
||
|
|
{ Event ID's }
|
||
|
|
EID_HTTPChatEvents = 'HTTPChatEvents';
|
||
|
|
EID_HTTPChatServerEvents = 'HTTPChatServerEvents';
|
||
|
|
|
||
|
|
type
|
||
|
|
{ Forward declarations }
|
||
|
|
IHTTPChatService = interface;
|
||
|
|
|
||
|
|
TUserInfoArray = class;
|
||
|
|
|
||
|
|
TUserInfo = class;
|
||
|
|
|
||
|
|
IHTTPChatEvents = interface;
|
||
|
|
IHTTPChatServerEvents = interface;
|
||
|
|
|
||
|
|
|
||
|
|
{ TUserInfo }
|
||
|
|
TUserInfo = class(TROComplexType)
|
||
|
|
private
|
||
|
|
fUserID: String;
|
||
|
|
fSessionID: String;
|
||
|
|
public
|
||
|
|
procedure Assign(iSource: TPersistent); override;
|
||
|
|
published
|
||
|
|
property UserID:String read fUserID write fUserID;
|
||
|
|
property SessionID:String read fSessionID write fSessionID;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TUserInfoCollection }
|
||
|
|
TUserInfoCollection = class(TROCollection)
|
||
|
|
protected
|
||
|
|
constructor Create(aItemClass: TCollectionItemClass); overload;
|
||
|
|
function GetItems(Index: integer): TUserInfo;
|
||
|
|
procedure SetItems(Index: integer; const Value: TUserInfo);
|
||
|
|
public
|
||
|
|
constructor Create; overload;
|
||
|
|
function Add: TUserInfo; reintroduce;
|
||
|
|
procedure SaveToArray(anArray: TUserInfoArray);
|
||
|
|
procedure LoadFromArray(anArray: TUserInfoArray);
|
||
|
|
property Items[Index: integer]:TUserInfo read GetItems write SetItems; default;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TUserInfoArray }
|
||
|
|
TUserInfoArray = class(TROArray)
|
||
|
|
private
|
||
|
|
fCount: Integer;
|
||
|
|
fItems : array of TUserInfo;
|
||
|
|
protected
|
||
|
|
procedure Grow; virtual;
|
||
|
|
function GetItems(Index: integer): TUserInfo;
|
||
|
|
procedure SetItems(Index: integer; const Value: TUserInfo);
|
||
|
|
function GetCount: integer; override;
|
||
|
|
public
|
||
|
|
class function GetItemType: PTypeInfo; override;
|
||
|
|
class function GetItemClass: TClass; override;
|
||
|
|
class function GetItemSize: integer; override;
|
||
|
|
function GetItemRef(Index: integer): pointer; override;
|
||
|
|
procedure SetItemRef(Index: integer; Ref: pointer); override;
|
||
|
|
procedure Clear; override;
|
||
|
|
procedure Delete(Index: integer); override;
|
||
|
|
procedure Resize(ElementCount: integer); override;
|
||
|
|
|
||
|
|
procedure Assign(iSource:TPersistent); override;
|
||
|
|
function Add: TUserInfo; overload;
|
||
|
|
function Add(const Value: TUserInfo):integer; overload;
|
||
|
|
|
||
|
|
property Count : integer read GetCount;
|
||
|
|
property Items[Index: integer]:TUserInfo read GetItems write SetItems; default;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ IHTTPChatService }
|
||
|
|
IHTTPChatService = interface
|
||
|
|
['{6893042C-3354-4AE6-B5FA-E7A637475C30}']
|
||
|
|
function Login(const aUserID: String): String;
|
||
|
|
procedure Logout;
|
||
|
|
procedure SendMessage(const aMessageText: String; const aDestination: String);
|
||
|
|
function GetLoggedUsers: TUserInfoArray;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ CoHTTPChatService }
|
||
|
|
CoHTTPChatService = class
|
||
|
|
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IHTTPChatService;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ THTTPChatService_Proxy }
|
||
|
|
THTTPChatService_Proxy = class(TROProxy, IHTTPChatService)
|
||
|
|
protected
|
||
|
|
function __GetInterfaceName:string; override;
|
||
|
|
|
||
|
|
function Login(const aUserID: String): String;
|
||
|
|
procedure Logout;
|
||
|
|
procedure SendMessage(const aMessageText: String; const aDestination: String);
|
||
|
|
function GetLoggedUsers: TUserInfoArray;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ IHTTPChatEvents }
|
||
|
|
IHTTPChatEvents = interface
|
||
|
|
['{75F9A466-518A-4B09-9DC4-9272B1EEFD95}']
|
||
|
|
procedure OnLogin(const aUserInfo: TUserInfo);
|
||
|
|
procedure OnLogout(const aUserID: String);
|
||
|
|
procedure OnSendMessage(const aSenderUserID: String; const aMessage: String; const aIsPrivateMessage: Boolean);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ IHTTPChatEvents_Writer }
|
||
|
|
IHTTPChatEvents_Writer = interface(IROEventsWriter)
|
||
|
|
['{75F9A466-518A-4B09-9DC4-9272B1EEFD95}']
|
||
|
|
procedure OnLogin(const __Sender : TGUID; const aUserInfo: TUserInfo);
|
||
|
|
procedure OnLogout(const __Sender : TGUID; const aUserID: String);
|
||
|
|
procedure OnSendMessage(const __Sender : TGUID; const aSenderUserID: String; const aMessage: String; const aIsPrivateMessage: Boolean);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ IHTTPChatServerEvents }
|
||
|
|
IHTTPChatServerEvents = interface
|
||
|
|
['{E80B0A2E-96ED-4F38-A6AC-E4E0B59F27F3}']
|
||
|
|
procedure OnSystemShutdown(const aShutdownDelay: Integer; const aReason: String);
|
||
|
|
procedure OnMandatoryClose(const aClientID: String; const aReason: String);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ IHTTPChatServerEvents_Writer }
|
||
|
|
IHTTPChatServerEvents_Writer = interface(IROEventsWriter)
|
||
|
|
['{E80B0A2E-96ED-4F38-A6AC-E4E0B59F27F3}']
|
||
|
|
procedure OnSystemShutdown(const __Sender : TGUID; const aShutdownDelay: Integer; const aReason: String);
|
||
|
|
procedure OnMandatoryClose(const __Sender : TGUID; const aClientID: String; const aReason: String);
|
||
|
|
end;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
{vcl:} SysUtils,
|
||
|
|
{RemObjects:} uROEventRepository, uRORes;
|
||
|
|
|
||
|
|
{ TUserInfoArray }
|
||
|
|
|
||
|
|
procedure TUserInfoArray.Assign(iSource: TPersistent);
|
||
|
|
var lSource:TUserInfoArray;
|
||
|
|
i:integer;
|
||
|
|
begin
|
||
|
|
if (iSource is TUserInfoArray) then begin
|
||
|
|
lSource := TUserInfoArray(iSource);
|
||
|
|
Clear();
|
||
|
|
Resize(lSource.Count);
|
||
|
|
for i := 0 to Count-1 do begin
|
||
|
|
if Assigned(lSource.Items[i]) then begin
|
||
|
|
Items[i] := lSource.Items[i].Clone() as TUserInfo;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
inherited Assign(iSource);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
class function TUserInfoArray.GetItemType: PTypeInfo;
|
||
|
|
begin
|
||
|
|
result := TypeInfo(TUserInfo);
|
||
|
|
end;
|
||
|
|
|
||
|
|
class function TUserInfoArray.GetItemClass: TClass;
|
||
|
|
begin
|
||
|
|
result := TUserInfo;
|
||
|
|
end;
|
||
|
|
|
||
|
|
class function TUserInfoArray.GetItemSize: integer;
|
||
|
|
begin
|
||
|
|
result := SizeOf(TUserInfo);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoArray.GetItems(Index: integer): TUserInfo;
|
||
|
|
begin
|
||
|
|
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
|
||
|
|
result := fItems[Index];
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoArray.GetItemRef(Index: integer): pointer;
|
||
|
|
begin
|
||
|
|
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
|
||
|
|
result := fItems[Index];
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoArray.SetItemRef(Index: integer; Ref: pointer);
|
||
|
|
begin
|
||
|
|
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
|
||
|
|
if Ref <> fItems[Index] then
|
||
|
|
fItems[Index] := Ref;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoArray.Clear;
|
||
|
|
var i: integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to (Count-1) do fItems[i].Free();
|
||
|
|
SetLength(fItems, 0);
|
||
|
|
FCount := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoArray.Delete(Index: integer);
|
||
|
|
var i: integer;
|
||
|
|
begin
|
||
|
|
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
|
||
|
|
|
||
|
|
fItems[Index].Free();
|
||
|
|
|
||
|
|
if (Index<Count-1) then
|
||
|
|
for i := Index to Count-2 do fItems[i] := fItems[i+1];
|
||
|
|
|
||
|
|
SetLength(fItems, Count-1);
|
||
|
|
Dec(FCount);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoArray.SetItems(Index: integer; const Value: TUserInfo);
|
||
|
|
begin
|
||
|
|
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
|
||
|
|
fItems[Index] := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoArray.Resize(ElementCount: integer);
|
||
|
|
begin
|
||
|
|
SetLength(fItems, ElementCount);
|
||
|
|
FCount := ElementCount;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoArray.GetCount: integer;
|
||
|
|
begin
|
||
|
|
result := FCount;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoArray.Grow;
|
||
|
|
var
|
||
|
|
Delta, Capacity: Integer;
|
||
|
|
begin
|
||
|
|
Capacity := Length(fItems);
|
||
|
|
if Capacity > 64 then
|
||
|
|
Delta := Capacity div 4
|
||
|
|
else
|
||
|
|
if Capacity > 8 then
|
||
|
|
Delta := 16
|
||
|
|
else
|
||
|
|
Delta := 4;
|
||
|
|
SetLength(fItems, Capacity + Delta);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoArray.Add: TUserInfo;
|
||
|
|
begin
|
||
|
|
result := TUserInfo.Create;
|
||
|
|
Add(Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoArray.Add(const Value:TUserInfo): integer;
|
||
|
|
begin
|
||
|
|
Result := Count;
|
||
|
|
if Length(fItems) = Result then
|
||
|
|
Grow;
|
||
|
|
fItems[result] := Value;
|
||
|
|
Inc(fCount);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TUserInfo }
|
||
|
|
|
||
|
|
procedure TUserInfo.Assign(iSource: TPersistent);
|
||
|
|
var lSource:TUserInfo;
|
||
|
|
begin
|
||
|
|
inherited Assign(iSource);
|
||
|
|
if (iSource is TUserInfo) then begin
|
||
|
|
lSource := TUserInfo(iSource);
|
||
|
|
UserID := lSource.UserID;
|
||
|
|
SessionID := lSource.SessionID;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TUserInfoCollection }
|
||
|
|
constructor TUserInfoCollection.Create;
|
||
|
|
begin
|
||
|
|
inherited Create(TUserInfo);
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TUserInfoCollection.Create(aItemClass: TCollectionItemClass);
|
||
|
|
begin
|
||
|
|
inherited Create(aItemClass);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoCollection.Add: TUserInfo;
|
||
|
|
begin
|
||
|
|
result := TUserInfo(inherited Add);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TUserInfoCollection.GetItems(Index: integer): TUserInfo;
|
||
|
|
begin
|
||
|
|
result := TUserInfo(inherited Items[Index]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoCollection.LoadFromArray(anArray: TUserInfoArray);
|
||
|
|
var i : integer;
|
||
|
|
begin
|
||
|
|
Clear;
|
||
|
|
for i := 0 to (anArray.Count-1) do
|
||
|
|
Add.Assign(anArray[i]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoCollection.SaveToArray(anArray: TUserInfoArray);
|
||
|
|
var i : integer;
|
||
|
|
begin
|
||
|
|
anArray.Clear;
|
||
|
|
anArray.Resize(Count);
|
||
|
|
for i := 0 to (Count-1) do begin
|
||
|
|
anArray[i] := TUserInfo.Create;
|
||
|
|
anArray[i].Assign(Items[i]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TUserInfoCollection.SetItems(Index: integer; const Value: TUserInfo);
|
||
|
|
begin
|
||
|
|
TUserInfo(inherited Items[Index]).Assign(Value);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ CoHTTPChatService }
|
||
|
|
|
||
|
|
class function CoHTTPChatService.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IHTTPChatService;
|
||
|
|
begin
|
||
|
|
result := THTTPChatService_Proxy.Create(aMessage, aTransportChannel);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ THTTPChatService_Proxy }
|
||
|
|
|
||
|
|
function THTTPChatService_Proxy.__GetInterfaceName:string;
|
||
|
|
begin
|
||
|
|
result := 'HTTPChatService';
|
||
|
|
end;
|
||
|
|
|
||
|
|
function THTTPChatService_Proxy.Login(const aUserID: String): String;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'HTTPChatLibrary', __InterfaceName, 'Login');
|
||
|
|
__Message.Write('aUserID', TypeInfo(String), aUserID, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__TransportChannel.Dispatch(__Message);
|
||
|
|
|
||
|
|
__Message.Read('Result', TypeInfo(String), result, []);
|
||
|
|
finally
|
||
|
|
__Message.FreeStream;
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatService_Proxy.Logout;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'HTTPChatLibrary', __InterfaceName, 'Logout');
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__TransportChannel.Dispatch(__Message);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__Message.FreeStream;
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatService_Proxy.SendMessage(const aMessageText: String; const aDestination: String);
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'HTTPChatLibrary', __InterfaceName, 'SendMessage');
|
||
|
|
__Message.Write('aMessageText', TypeInfo(String), aMessageText, []);
|
||
|
|
__Message.Write('aDestination', TypeInfo(String), aDestination, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__TransportChannel.Dispatch(__Message);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__Message.FreeStream;
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
function THTTPChatService_Proxy.GetLoggedUsers: TUserInfoArray;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
result := nil;
|
||
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'HTTPChatLibrary', __InterfaceName, 'GetLoggedUsers');
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__TransportChannel.Dispatch(__Message);
|
||
|
|
|
||
|
|
__Message.Read('Result', TypeInfo(HTTPChatLibrary_Intf.TUserInfoArray), result, []);
|
||
|
|
finally
|
||
|
|
__Message.FreeStream;
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
type
|
||
|
|
{ THTTPChatEvents_Writer }
|
||
|
|
THTTPChatEvents_Writer = class(TROEventWriter, IHTTPChatEvents_Writer)
|
||
|
|
protected
|
||
|
|
procedure OnLogin(const __Sender : TGUID; const aUserInfo: TUserInfo);
|
||
|
|
procedure OnLogout(const __Sender : TGUID; const aUserID: String);
|
||
|
|
procedure OnSendMessage(const __Sender : TGUID; const aSenderUserID: String; const aMessage: String; const aIsPrivateMessage: Boolean);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatEvents_Writer.OnLogin(const __Sender : TGUID; const aUserInfo: TUserInfo);
|
||
|
|
var __eventdata : Binary;
|
||
|
|
begin
|
||
|
|
__eventdata := Binary.Create;
|
||
|
|
try
|
||
|
|
__Message.InitializeEventMessage(NIL, 'HTTPChatLibrary', EID_HTTPChatEvents, 'OnLogin');
|
||
|
|
__Message.Write('aUserInfo', TypeInfo(TUserInfo), aUserInfo, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__Message.WriteToStream(__eventdata);
|
||
|
|
|
||
|
|
Repository.StoreEventData(__Sender, __eventdata, ExcludeSender, ExcludeSessionList, SessionList.CommaText);
|
||
|
|
except
|
||
|
|
__eventdata.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatEvents_Writer.OnLogout(const __Sender : TGUID; const aUserID: String);
|
||
|
|
var __eventdata : Binary;
|
||
|
|
begin
|
||
|
|
__eventdata := Binary.Create;
|
||
|
|
try
|
||
|
|
__Message.InitializeEventMessage(NIL, 'HTTPChatLibrary', EID_HTTPChatEvents, 'OnLogout');
|
||
|
|
__Message.Write('aUserID', TypeInfo(String), aUserID, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__Message.WriteToStream(__eventdata);
|
||
|
|
|
||
|
|
Repository.StoreEventData(__Sender, __eventdata, ExcludeSender, ExcludeSessionList, SessionList.CommaText);
|
||
|
|
except
|
||
|
|
__eventdata.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatEvents_Writer.OnSendMessage(const __Sender : TGUID; const aSenderUserID: String; const aMessage: String; const aIsPrivateMessage: Boolean);
|
||
|
|
var __eventdata : Binary;
|
||
|
|
begin
|
||
|
|
__eventdata := Binary.Create;
|
||
|
|
try
|
||
|
|
__Message.InitializeEventMessage(NIL, 'HTTPChatLibrary', EID_HTTPChatEvents, 'OnSendMessage');
|
||
|
|
__Message.Write('aSenderUserID', TypeInfo(String), aSenderUserID, []);
|
||
|
|
__Message.Write('aMessage', TypeInfo(String), aMessage, []);
|
||
|
|
__Message.Write('aIsPrivateMessage', TypeInfo(Boolean), aIsPrivateMessage, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__Message.WriteToStream(__eventdata);
|
||
|
|
|
||
|
|
Repository.StoreEventData(__Sender, __eventdata, ExcludeSender, ExcludeSessionList, SessionList.CommaText);
|
||
|
|
except
|
||
|
|
__eventdata.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
type
|
||
|
|
{ THTTPChatEvents_Invoker }
|
||
|
|
THTTPChatEvents_Invoker = class(TROEventInvoker)
|
||
|
|
published
|
||
|
|
procedure Invoke_OnLogin(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
procedure Invoke_OnLogout(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
procedure Invoke_OnSendMessage(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatEvents_Invoker.Invoke_OnLogin(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
var
|
||
|
|
__lObjectDisposer: TROObjectDisposer;
|
||
|
|
aUserInfo: TUserInfo;
|
||
|
|
begin
|
||
|
|
aUserInfo := NIL;
|
||
|
|
|
||
|
|
try
|
||
|
|
__Message.Read('aUserInfo', TypeInfo(TUserInfo), aUserInfo, []);
|
||
|
|
|
||
|
|
(__Target as IHTTPChatEvents).OnLogin(aUserInfo);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__lObjectDisposer:= TROObjectDisposer.Create(__EventReceiver);
|
||
|
|
try
|
||
|
|
__lObjectDisposer.Add(aUserInfo);
|
||
|
|
finally
|
||
|
|
__lObjectDisposer.Free();
|
||
|
|
end
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatEvents_Invoker.Invoke_OnLogout(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
var
|
||
|
|
__lObjectDisposer: TROObjectDisposer;
|
||
|
|
aUserID: String;
|
||
|
|
begin
|
||
|
|
|
||
|
|
try
|
||
|
|
__Message.Read('aUserID', TypeInfo(String), aUserID, []);
|
||
|
|
|
||
|
|
(__Target as IHTTPChatEvents).OnLogout(aUserID);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__lObjectDisposer:= TROObjectDisposer.Create(__EventReceiver);
|
||
|
|
try
|
||
|
|
finally
|
||
|
|
__lObjectDisposer.Free();
|
||
|
|
end
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatEvents_Invoker.Invoke_OnSendMessage(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
var
|
||
|
|
__lObjectDisposer: TROObjectDisposer;
|
||
|
|
aSenderUserID: String;
|
||
|
|
aMessage: String;
|
||
|
|
aIsPrivateMessage: Boolean;
|
||
|
|
begin
|
||
|
|
|
||
|
|
try
|
||
|
|
__Message.Read('aSenderUserID', TypeInfo(String), aSenderUserID, []);
|
||
|
|
__Message.Read('aMessage', TypeInfo(String), aMessage, []);
|
||
|
|
__Message.Read('aIsPrivateMessage', TypeInfo(Boolean), aIsPrivateMessage, []);
|
||
|
|
|
||
|
|
(__Target as IHTTPChatEvents).OnSendMessage(aSenderUserID, aMessage, aIsPrivateMessage);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__lObjectDisposer:= TROObjectDisposer.Create(__EventReceiver);
|
||
|
|
try
|
||
|
|
finally
|
||
|
|
__lObjectDisposer.Free();
|
||
|
|
end
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
type
|
||
|
|
{ THTTPChatServerEvents_Writer }
|
||
|
|
THTTPChatServerEvents_Writer = class(TROEventWriter, IHTTPChatServerEvents_Writer)
|
||
|
|
protected
|
||
|
|
procedure OnSystemShutdown(const __Sender : TGUID; const aShutdownDelay: Integer; const aReason: String);
|
||
|
|
procedure OnMandatoryClose(const __Sender : TGUID; const aClientID: String; const aReason: String);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatServerEvents_Writer.OnSystemShutdown(const __Sender : TGUID; const aShutdownDelay: Integer; const aReason: String);
|
||
|
|
var __eventdata : Binary;
|
||
|
|
begin
|
||
|
|
__eventdata := Binary.Create;
|
||
|
|
try
|
||
|
|
__Message.InitializeEventMessage(NIL, 'HTTPChatLibrary', EID_HTTPChatServerEvents, 'OnSystemShutdown');
|
||
|
|
__Message.Write('aShutdownDelay', TypeInfo(Integer), aShutdownDelay, []);
|
||
|
|
__Message.Write('aReason', TypeInfo(String), aReason, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__Message.WriteToStream(__eventdata);
|
||
|
|
|
||
|
|
Repository.StoreEventData(__Sender, __eventdata, ExcludeSender, ExcludeSessionList, SessionList.CommaText);
|
||
|
|
except
|
||
|
|
__eventdata.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatServerEvents_Writer.OnMandatoryClose(const __Sender : TGUID; const aClientID: String; const aReason: String);
|
||
|
|
var __eventdata : Binary;
|
||
|
|
begin
|
||
|
|
__eventdata := Binary.Create;
|
||
|
|
try
|
||
|
|
__Message.InitializeEventMessage(NIL, 'HTTPChatLibrary', EID_HTTPChatServerEvents, 'OnMandatoryClose');
|
||
|
|
__Message.Write('aClientID', TypeInfo(String), aClientID, []);
|
||
|
|
__Message.Write('aReason', TypeInfo(String), aReason, []);
|
||
|
|
__Message.Finalize;
|
||
|
|
|
||
|
|
__Message.WriteToStream(__eventdata);
|
||
|
|
|
||
|
|
Repository.StoreEventData(__Sender, __eventdata, ExcludeSender, ExcludeSessionList, SessionList.CommaText);
|
||
|
|
except
|
||
|
|
__eventdata.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
type
|
||
|
|
{ THTTPChatServerEvents_Invoker }
|
||
|
|
THTTPChatServerEvents_Invoker = class(TROEventInvoker)
|
||
|
|
published
|
||
|
|
procedure Invoke_OnSystemShutdown(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
procedure Invoke_OnMandatoryClose(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatServerEvents_Invoker.Invoke_OnSystemShutdown(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
var
|
||
|
|
__lObjectDisposer: TROObjectDisposer;
|
||
|
|
aShutdownDelay: Integer;
|
||
|
|
aReason: String;
|
||
|
|
begin
|
||
|
|
|
||
|
|
try
|
||
|
|
__Message.Read('aShutdownDelay', TypeInfo(Integer), aShutdownDelay, []);
|
||
|
|
__Message.Read('aReason', TypeInfo(String), aReason, []);
|
||
|
|
|
||
|
|
(__Target as IHTTPChatServerEvents).OnSystemShutdown(aShutdownDelay, aReason);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__lObjectDisposer:= TROObjectDisposer.Create(__EventReceiver);
|
||
|
|
try
|
||
|
|
finally
|
||
|
|
__lObjectDisposer.Free();
|
||
|
|
end
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure THTTPChatServerEvents_Invoker.Invoke_OnMandatoryClose(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);
|
||
|
|
var
|
||
|
|
__lObjectDisposer: TROObjectDisposer;
|
||
|
|
aClientID: String;
|
||
|
|
aReason: String;
|
||
|
|
begin
|
||
|
|
|
||
|
|
try
|
||
|
|
__Message.Read('aClientID', TypeInfo(String), aClientID, []);
|
||
|
|
__Message.Read('aReason', TypeInfo(String), aReason, []);
|
||
|
|
|
||
|
|
(__Target as IHTTPChatServerEvents).OnMandatoryClose(aClientID, aReason);
|
||
|
|
|
||
|
|
finally
|
||
|
|
__lObjectDisposer:= TROObjectDisposer.Create(__EventReceiver);
|
||
|
|
try
|
||
|
|
finally
|
||
|
|
__lObjectDisposer.Free();
|
||
|
|
end
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
RegisterROClass(TUserInfo);
|
||
|
|
RegisterROClass(TUserInfoArray);
|
||
|
|
RegisterProxyClass(IHTTPChatService_IID, THTTPChatService_Proxy);
|
||
|
|
|
||
|
|
RegisterEventWriterClass(IHTTPChatEvents_Writer, THTTPChatEvents_Writer);
|
||
|
|
RegisterEventInvokerClass(EID_HTTPChatEvents, THTTPChatEvents_Invoker);
|
||
|
|
RegisterEventWriterClass(IHTTPChatServerEvents_Writer, THTTPChatServerEvents_Writer);
|
||
|
|
RegisterEventInvokerClass(EID_HTTPChatServerEvents, THTTPChatServerEvents_Invoker);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
UnregisterROClass(TUserInfo);
|
||
|
|
UnregisterROClass(TUserInfoArray);
|
||
|
|
UnregisterProxyClass(IHTTPChatService_IID);
|
||
|
|
|
||
|
|
UnregisterEventWriterClass(IHTTPChatEvents_Writer);
|
||
|
|
UnregisterEventInvokerClass(EID_HTTPChatEvents);
|
||
|
|
UnregisterEventWriterClass(IHTTPChatServerEvents_Writer);
|
||
|
|
UnregisterEventInvokerClass(EID_HTTPChatServerEvents);
|
||
|
|
end.
|