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) 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.