unit HTTPChatService_Impl; {----------------------------------------------------------------------------} { This unit was automatically generated by the RemObjects SDK after reading } { the RODL file associated with this project . } { } { This is where you are supposed to code the implementation of your objects. } {----------------------------------------------------------------------------} interface uses {vcl:} Classes, SysUtils, {RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions, {Required:} uRORemoteDataModule, SyncObjs, {Generated:} HTTPChatLibrary_Intf; type { THTTPChatService } THTTPChatService = class(TRORemoteDataModule, IHTTPChatService) procedure RORemoteDataModuleActivate(const aClientID: TGUID; aSession: TROSession; const aMessage: IROMessage); private protected { IHTTPChatService methods } function Login(const aUserID: string): string; procedure Logout; procedure SendMessage(const aMessageText: string; const aDestination: string); function GetLoggedUsers: TUserInfoArray; public end; var fCs: TCriticalSection; fUsers: TUserInfoArray; implementation {$R *.dfm} uses {Generated:} HTTPChatLibrary_Invk, HTTPChatServerMain, Variants; procedure Create_HTTPChatService(out anInstance: IUnknown); begin anInstance := THTTPChatService.Create(nil); end; { HTTPChatService } function THTTPChatService.Login(const aUserID: string): string; var newuser: TUserInfo; ev: IHTTPChatEvents_Writer; begin fcs.Enter; try { Checks if the user is already logged in } if (fUsers.Search('UserID', aUserID) <> nil) then raise Exception.CreateFmt('User %s is already logged in', [aUserID]); { Adds the user to the internal list of logged users } newuser := fUsers.Add; newuser.UserID := aUserID; newuser.SessionID := GUIDToString(Session.SessionID); { Stores the UserID of the user in the session. This will be used in the OnLogout and OnSendMessage methods } Session.Values['UserID'] := aUserID; result := newuser.SessionID; ev := (EventRepository as IHTTPChatEvents_Writer); ev.ExcludeSender := false; // make sure to send it back to sender too { Generates the OnLogin event } ev.OnLogin(Session.SessionID, newuser); finally fcs.Release; end; end; procedure THTTPChatService.Logout; var userid: string; useridx: integer; ev: IHTTPChatEvents_Writer; begin { Finds the user in the fUser array and removes it } userid := VarToStr(Session.Values['UserID']); fcs.Enter; try useridx := fUsers.GetIndex('UserID', UserID); if (useridx >= 0) then fUsers.Delete(useridx); { Eliminates this user's session } DestroySession; ev := (EventRepository as IHTTPChatEvents_Writer); { Generates the OnLogout event } ev.OnLogout(Session.SessionID, UserID); finally fcs.Release; end; end; procedure THTTPChatService.SendMessage(const aMessageText: string; const aDestination: string); var thisuserid: string; chateventswriter: IHTTPChatEvents_Writer; begin { Extracts the name of the current user by reading the session information } thisuserid := VarToStr(Session.Values['UserID']); { Filters the receivers of this event if necessary } chateventswriter := (EventRepository as IHTTPChatEvents_Writer); if (aDestination <> '') then begin chateventswriter.SessionList.CommaText := aDestination; { Only broadcasts to the session listed in SessionList } chateventswriter.ExcludeSessionList := FALSE; end; chateventswriter.ExcludeSender := false; { Generates the OnSendMessage event } chateventswriter.OnSendMessage(Session.SessionID, thisuserid, aMessageText, aDestination <> ''); end; function THTTPChatService.GetLoggedUsers: TUserInfoArray; begin result := TUserInfoArray.Create; fcs.Enter; try result.Assign(fUsers); finally fcs.Release; end; end; procedure THTTPChatService.RORemoteDataModuleActivate( const aClientID: TGUID; aSession: TROSession; const aMessage: IROMessage); begin { We manually assign this because the user might decide to change it at runtime, by using the combo box on the main form } EventRepository := HTTPChatServerMainForm.EventRepository; end; initialization fCs := TCriticalSection.Create; fUsers := TUserInfoArray.Create; TROClassFactory.Create('HTTPChatService', Create_HTTPChatService, THTTPChatService_Invoker); finalization FreeAndNil(fUsers); fCs.Free; end.