unit MainForm;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Generics.Collections, ChannelID,
  Dialogs, DSCommonServer, DSHTTPCommon, DSHTTP, DSServer, StdCtrls,
  IndyPeerImpl;

type
  TServerForm = class(TForm)
    DSServer1: TDSServer;
    DSHTTPService1: TDSHTTPService;
    btnCallbacks: TButton;
    ListBox1: TListBox;
    btnCallClient: TButton;
    btnCallbackAll: TButton;
    btnDisconnectCallbacks: TButton;
    edCallbackInfo: TEdit;
    procedure btnCallbacksClick(Sender: TObject);
    procedure btnCallClientClick(Sender: TObject);
    procedure btnCallbackAllClick(Sender: TObject);
    procedure btnDisconnectCallbacksClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ServerForm: TServerForm;

implementation
uses
  DBXJSON;

{$R *.dfm}

procedure TServerForm.btnCallbacksClick(Sender: TObject);
var
  clients: TList<String>;
  client: String;
begin
  ListBox1.Clear;
  clients := DSServer1.GetAllChannelCallbackId(ChannelName);
  try
    for client in clients do
      ListBox1.Items.Add(client)
  finally
    clients.Free
  end;
end;

procedure TServerForm.btnCallbackAllClick(Sender: TObject);
var
  CallbackTunnel: TDSCallbackTunnel;
  JSONMsg: TJSONObject;
begin
  // wrap the message in a JSON object
  JSONMsg := TJSONObject.Create;
  CallbackTunnel := DSServer1.GetCallbackTunnel(ChannelName); // , client);
  if Assigned(CallbackTunnel) then
  begin
    JSONMsg.AddPair(TJSONPair.Create(ChannelName+'Tunnel',
      edCallbackInfo.Text + ' at: ' + DateTimeToStr(Now)));
    CallbackTunnel.BroadcastMessage(JSONMsg)
  end
  else // use ChannelName
  begin
    JSONMsg.AddPair(TJSONPair.Create(ChannelName,
      edCallbackInfo.Text + ' at: ' + DateTimeToStr(Now)));
    DSServer1.BroadcastMessage(ChannelName, JSONMsg)
  end
end;

procedure TServerForm.btnCallClientClick(Sender: TObject);
var
  CallbackTunnel: TDSCallbackTunnel;
  JSONMsg: TJSONObject;
  client: String;
begin
  client := ListBox1.Items[ListBox1.ItemIndex];
  // wrap the message in a JSON object
  JSONMsg := TJSONObject.Create;
  CallbackTunnel := DSServer1.GetCallbackTunnel(ChannelName);
  if Assigned(CallbackTunnel) then
  begin
    JSONMsg.AddPair(TJSONPair.Create(ChannelName+'Tunnel',
      edCallbackInfo.Text + ' at: ' + DateTimeToStr(Now)));
    CallbackTunnel.BroadcastMessage(client, JSONMsg) // client = GUID
  end
  else // use ChannelName
  begin
    JSONMsg.AddPair(TJSONPair.Create(ChannelName,
      edCallbackInfo.Text + ' at: ' + DateTimeToStr(Now)));
    DSServer1.BroadcastMessage(ChannelName, client, JSONMsg) // client = GUID
  end
end;

procedure TServerForm.btnDisconnectCallbacksClick(Sender: TObject);
var
  CallbackTunnel: TDSCallbackTunnel;
begin
  CallbackTunnel := DSServer1.GetCallbackTunnel(ChannelName);
  DSServer1.UnregisterChannelCallback(CallbackTunnel)
end;

procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  btnDisconnectCallbacksClick(Sender);
  Sleep(1000); // give callback time to close...
  DSServer1.Stop
end;

end.
