david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
144 lines
4.5 KiB
ObjectPascal
144 lines
4.5 KiB
ObjectPascal
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.
|