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

unit HTTPChatClientMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClientIntf, uRORemoteService, uROBinMessage, uROWinInetHTTPChannel,
  Buttons,  HTTPChatLibrary_Intf,
  uRODynamicRequest, uROEventRepository,
  uROPoweredByRemObjectsButton, uROClient, ComCtrls;

type
  TMessageType = (mtMessage, mtSystem);

type
  THTTPChatClientMainForm = class(TForm, IHTTPChatEvents, IHTTPChatServerEvents)
    ROMessage: TROBinMessage;
    ROChannel: TROWinInetHTTPChannel;
    svcChatService: TRORemoteService;
    Memo: TMemo;
    Label1: TLabel;
    eUserID: TEdit;
    LoginButton: TBitBtn;
    LogoutButton: TBitBtn;
    eMessage: TEdit;
    SendButton: TBitBtn;
    EventReceiver: TROEventReceiver;
    Label2: TLabel;
    cbServer: TComboBox;
    ROPoweredByRemObjectsButton1: TROPoweredByRemObjectsButton;
    lvLoggedUsers: TListView;
    Label3: TLabel;
    Label4: TLabel;
    cbPrivateMessage: TCheckBox;
    StatusBar: TStatusBar;
    RefreshButton: TButton;
    procedure LoginButtonClick(Sender: TObject);
    procedure LogoutButtonClick(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
    procedure eMessageChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RefreshButtonClick(Sender: TObject);
  private
    fChatService: IHTTPChatService;
    fLoggedIn: boolean;
    fUsers: TUserInfoArray;

    function GetUserID: string;
    procedure ToggleControls;

    procedure WriteMessage(aMessageType: TMessageType; const aSender, aMessage: string; IsPrivate: boolean = FALSE);

    { IChatEvents }
    procedure OnLogin(const aUserInfo: TUserInfo);
    procedure OnLogout(const aUserID: string);
    procedure OnSendMessage(const aSenderUserID: string; const aMessage: string; const aIsPrivateMessage: Boolean);

    { IChatServerEvents }
    procedure OnSystemShutdown(const aShutdownDelay: Integer; const aReason: string);
    procedure OnMandatoryClose(const aClientID: string; const aReason: string);
    procedure RefreshLoggedUserList;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    property LoggedIn: boolean read fLoggedIn;
    property UserID: string read GetUserID;

  end;

var
  HTTPChatClientMainForm: THTTPChatClientMainForm;

implementation

uses StdConvs;

{$R *.dfm}

constructor THTTPChatClientMainForm.Create(aOwner: TComponent);
begin
  inherited;

  fChatService := (svcChatService as IHTTPChatService);

  eUserID.Text := eUserID.Text + FormatDateTime('HHMMSS', Now);
  ToggleControls;
end;

destructor THTTPChatClientMainForm.Destroy;
begin
  FreeAndNIL(fUsers);

  inherited;
end;

function THTTPChatClientMainForm.GetUserID: string;
begin
  result := Trim(eUserID.Text);
end;

procedure THTTPChatClientMainForm.ToggleControls;
begin
  eUserID.Enabled := not LoggedIn;
  LoginButton.Enabled := not LoggedIn;
  LogoutButton.Enabled := LoggedIn;
  Memo.Enabled := LoggedIn;
  SendButton.Enabled := LoggedIn;
end;

procedure THTTPChatClientMainForm.SendButtonClick(Sender: TObject);
var
  destination: string;
  i: integer;
  userinfo: TUserInfo;
begin
  { If this is a private message, then builds the list of receivers }
  destination := '';
  if cbPrivateMessage.Checked then begin
    for i := 0 to (lvLoggedUsers.Items.Count - 1) do begin
      if lvLoggedUsers.Items[i].Checked then begin
        userinfo := lvLoggedUsers.Items[i].Data;
        destination := destination + userinfo.SessionID + ',';
      end;
    end;

    if (destination = '') then begin
      Beep;
      MessageDlg('Select one or more recipients for your private message first', mtError, [mbOK], 0);
      Exit;
    end;
  end;

  { Sends the message }
  fChatService.SendMessage(eMessage.Text, Copy(destination, 1, Length(destination) - 1));
  eMessage.Text := '';
  eMessage.SetFocus;
end;

procedure THTTPChatClientMainForm.WriteMessage(aMessageType: TMessageType;
  const aSender, aMessage: string;
  IsPrivate: boolean = FALSE);
var
  line: string;
begin
  case aMessageType of
    mtSystem: line := 'SYS>' + aMessage;
    mtMessage: line := aSender + '>' + aMessage;
  end;

  if IsPrivate then line := '[PRIVATE] ' + line;
  Memo.Lines.Add(line);
end;

procedure THTTPChatClientMainForm.LoginButtonClick(Sender: TObject);
begin
  try
    ROChannel.TargetURL := cbServer.Text;

    { Calls the remote login method }
    ROMessage.ClientID := StringToGUID(fChatService.Login(UserID));
    StatusBar.SimpleText := GUIDToString(ROMessage.ClientID);

    fUsers := fChatService.GetLoggedUsers;
    RefreshLoggedUserList;

    { Register the event handlers }
    EventReceiver.RegisterEventHandlers([EID_HTTPChatEvents, EID_HTTPChatServerEvents], [Self, Self]);

    { Starts polling }
    EventReceiver.Active := TRUE;

    fLoggedIn := TRUE;
  finally
    ToggleControls;
  end;
end;

procedure THTTPChatClientMainForm.LogoutButtonClick(Sender: TObject);
begin
  try
    EventReceiver.Active := FALSE; // Stops polling for messages
    EventReceiver.UnregisterEventHandlers([EID_HTTPChatEvents, EID_HTTPChatServerEvents]); // Unregisters the event handlers

    fChatService.Logout;

    FreeAndNIL(fUsers);

    fLoggedIn := FALSE;
  finally
    RefreshLoggedUserList;
    ToggleControls;
  end;
end;

procedure THTTPChatClientMainForm.RefreshLoggedUserList;
var
  i: integer;
begin
  lvLoggedUsers.Items.BeginUpdate;
  lvLoggedUsers.Items.Clear;
  try
    if (fUsers = nil) then Exit; // After Logout

    for i := 0 to (fUsers.Count - 1) do begin
      if fUsers[i].UserID = UserID then Continue; // Skips itself

      with lvLoggedUsers.Items.Add do begin
        Caption := fUsers[i].UserID;
        Data := fUsers[i];
      end;
    end;
  finally
    lvLoggedUsers.Items.EndUpdate;
  end;
end;

// ChatEvents implementation

procedure THTTPChatClientMainForm.OnLogin(const aUserInfo: TUserInfo);
begin
  WriteMessage(mtSystem, '', 'User ' + aUserInfo.UserID + ' just logged in');

  fUsers.Add(aUserInfo);
  EventReceiver.RetainObject(aUserInfo);

  RefreshLoggedUserList;
end;

procedure THTTPChatClientMainForm.OnLogout(const aUserID: string);
var
  idx: integer;
begin
  WriteMessage(mtSystem, '', 'User ' + aUserID + ' logged out');

  idx := fUsers.GetIndex('UserID', aUserID);
  if (idx >= 0) then begin
    fUsers.Delete(idx);
    RefreshLoggedUserList;
  end;
end;

procedure THTTPChatClientMainForm.OnSendMessage(const aSenderUserID: string; const aMessage: string; const aIsPrivateMessage: Boolean);
begin
  WriteMessage(mtMessage, aSenderUserID, aMessage, aIsPrivateMessage);
end;

procedure THTTPChatClientMainForm.eMessageChange(Sender: TObject);
begin
  SendButton.Enabled := (eMessage.Text <> '') and LoggedIn
end;

procedure THTTPChatClientMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try
    if LogoutButton.Enabled then
       LogoutButton.Click;
  except
  end;
end;

procedure THTTPChatClientMainForm.OnMandatoryClose(const aClientID: string; const aReason: string);
var
  thisclientid: string;
begin
  thisclientid := GUIDToString(EventReceiver.ClientID);
  if (aClientID = thisclientid) then begin

    LogoutButton.Click;

    Beep;
    MessageDlg('You''ve been disconnected from the server.'#13'Reason: ' + aReason, mtWarning, [mbOK], 0);

    Close;
  end;
end;

procedure THTTPChatClientMainForm.OnSystemShutdown(const aShutdownDelay: Integer;
  const aReason: string);
begin
  Beep;
  MessageDlg(Format('The server will be shut down in %d minutes.'#13'Reason: %s', [aShutdownDelay, aReason]), mtWarning, [mbOK], 0);
end;

procedure THTTPChatClientMainForm.RefreshButtonClick(Sender: TObject);
begin
  fUsers:= fChatService.GetLoggedUsers;
  RefreshLoggedUserList;
end;

end.