Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/HTTP Chat/HTTPChatService_Impl.pas

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.