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

unit HTTPChatServerMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClient, uROPoweredByRemObjectsButton, uROClientIntf, uROServer,
  uROIndyHTTPServer, uROIndyTCPServer, HTTPChatLibrary_Intf,
  uROSessions, uROEventRepository,  
  uROBinMessage, uROSOAPMessage, Buttons, uROIndyTCPChannel,
  uROMasterServerEventRepository, Spin;

type
  THTTPChatServerMainForm = class(TForm)
    RoPoweredByRemObjectsButton1: TRoPoweredByRemObjectsButton;
    BINMessage: TROBinMessage;
    ROServer: TROIndyHTTPServer;
    InMemorySessionManager: TROInMemorySessionManager;
    lbSessions: TListBox;
    bbCloseClient: TBitBtn;
    bbWarnShutdown: TBitBtn;
    ROIndyTCPChannel1: TROIndyTCPChannel;
    cbRepositoryType: TComboBox;
    Label1: TLabel;
    InMemoryEventRepository: TROInMemoryEventRepository;
    Label2: TLabel;
    ActivateButton: TBitBtn;
    MasterServerEventRepository: TROMasterServerEventRepository;
    Label3: TLabel;
    sePort: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure bbWarnShutdownClick(Sender: TObject);
    procedure bbCloseClientClick(Sender: TObject);
    procedure ActivateButtonClick(Sender: TObject);
    procedure InMemoryEventRepositoryAfterAddSession(
      Sender: TROEventRepository; const SessionID: TGUID);
    procedure InMemoryEventRepositoryAfterRemoveSession(
      Sender: TROEventRepository; const SessionID: TGUID);
    procedure InMemorySessionManagerSessionDeleted(const aSessionID: TGUID;
      IsExpired: Boolean);
  private
    function GetEventRepository: TROEventRepository;
  protected

  public
    property EventRepository : TROEventRepository read GetEventRepository;
  end;

var
  HTTPChatServerMainForm: THTTPChatServerMainForm;

implementation

uses uROClasses, uROAsync, Variants;

{$R *.dfm}

procedure THTTPChatServerMainForm.FormCreate(Sender: TObject);
var i : integer;
begin
  sePort.Value := ROServer.Port;
  
  for i := 0 to (ComponentCount-1) do
    if (Components[i] is TROEventRepository) then
      cbRepositoryType.Items.AddObject(Components[i].Name, Components[i]);

  cbRepositoryType.ItemIndex := 0;
end;

procedure THTTPChatServerMainForm.bbWarnShutdownClick(Sender: TObject);
var reason : string;
begin
  reason := 'The system administrator will reboot the server in 5 minutes.'#13#13+
            'Please close your applications and save your work.';

  if InputQuery('Shutdown Reason', 'Reason', reason)
    then (EventRepository as IHTTPChatServerEvents_Writer).OnSystemShutdown(EmptyGUID, 5, reason);
end;

procedure THTTPChatServerMainForm.bbCloseClientClick(Sender: TObject);
var reason : string;
    clientid : TGUID;
begin
  if lbSessions.ItemIndex<0 then begin
    Beep;
    MessageDlg('Select a session first', mtError, [mbOK], 0);
    Exit;
  end;

  clientid := StringToGUID(lbSessions.Items[lbSessions.ItemIndex]);

  reason := 'You''ve been terminated. Good bye!';
  if InputQuery('Close Reason', 'Reason', reason)
    then (EventRepository as IHTTPChatServerEvents_Writer).OnMandatoryClose(EmptyGUID, GUIDToString(clientid), reason);
end;

function THTTPChatServerMainForm.GetEventRepository: TROEventRepository;
begin
  result := TROEventRepository(cbRepositoryType.Items.Objects[cbRepositoryType.ItemIndex]);
end;

procedure THTTPChatServerMainForm.ActivateButtonClick(Sender: TObject);
begin
  if not ROServer.Active then begin
    ROServer.Port := sePort.Value;
  end;

  ROServer.Active := ROServer.Active XOR TRUE;

  cbRepositoryType.Enabled := not ROServer.Active;
  bbCloseClient.Enabled := ROServer.Active;
  bbWarnShutdown.Enabled := ROServer.Active;
end;

procedure THTTPChatServerMainForm.InMemoryEventRepositoryAfterAddSession(
  Sender: TROEventRepository; const SessionID: TGUID);
begin
  lbSessions.Items.Add(GUIDToString(SessionID));
end;

procedure THTTPChatServerMainForm.InMemoryEventRepositoryAfterRemoveSession(
  Sender: TROEventRepository; const SessionID: TGUID);
var idx : integer;
begin
  if (csDestroying in ComponentState) then Exit;

  idx := lbSessions.Items.IndexOf(GUIDToString(SessionID));
  if (idx>=0)
    then lbSessions.Items.Delete(idx);
end;

procedure THTTPChatServerMainForm.InMemorySessionManagerSessionDeleted(
  const aSessionID: TGUID; IsExpired: Boolean);
var idx : integer;
begin
  if (csDestroying in ComponentState) then Exit;

  idx := lbSessions.Items.IndexOf(GUIDToString(aSessionID));
  if (idx>=0)
    then lbSessions.Items.Delete(idx);
end;

end.