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.