Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/Service Discovery/ServiceDiscoveryMain.pas

unit ServiceDiscoveryMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uROClient, uROBINMessage, uRODiscovery, 
  uROIndyUDPChannel, uROBroadcastChannel,  uROServer,
  uROIndyUDPServer, uROBroadcastServer, StdCtrls, ExtCtrls, Buttons,
  uROPoweredByRemObjectsButton, uRODiscovery_Intf, ActnList;

type
  TServiceDiscoveryMainForm = class(TForm)
    ROBroadcastServer: TROBroadcastServer;
    ROBroadcastChannel: TROBroadcastChannel;
    RODiscoveryClient: TRODiscoveryClient;
    RODiscoveryServer: TRODiscoveryServer;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ed_ServiceName: TEdit;
    btn_LookupService: TBitBtn;
    lb_Servers: TListBox;
    Label2: TLabel;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    ed_Services: TMemo;
    RoPoweredByRemObjectsButton1: TRoPoweredByRemObjectsButton;
    ROBINMessage_Server: TROBINMessage;
    ROBINMessage_Client: TROBINMessage;
    Panel1: TPanel;
    Label4: TLabel;
    cb_SupportRegisteredServerClasses: TCheckBox;
    GroupBox3: TGroupBox;
    ed_ServerLoad: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    ed_MaxLoad: TEdit;
    ActionList: TActionList;
    ac_DiscoverServers: TAction;
    cb_ReturnInfo: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure btn_UpdateServiceListClick(Sender: TObject);
    procedure btn_LookupServiceClick(Sender: TObject);
    procedure RODiscoveryClientNewServersFound(Sender: TObject);
    procedure cb_SupportRegisteredServerClassesClick(Sender: TObject);
    procedure ActionListUpdate(Action: TBasicAction;
      var Handled: Boolean);
    procedure RODiscoveryServerServiceFound(aSender: TObject;
      aName: String; var ioDiscoveryOptions: TRODiscoveryOptions;
      var ioHandled: Boolean);
    procedure RODiscoveryClientNewServiceFound(aSender: TObject;
      aName: String; aDiscoveryOptions: TRODiscoveryOptions);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyDiscoveryQueryOptions = class(TRODiscoveryOptions)
  private
    fMaximumLoad: integer;
  published
    property MaximumLoad: integer read fMaximumLoad write fMaximumLoad;
  end;

  TMyDiscoveryResultOptions = class(TRODiscoveryOptions)
  private
    fServerTime: TDateTime;
    fMoreInfo: string;
    fLoad: integer;
  published
    property ServerTime: TDateTime read fServerTime write fServerTime;
    property MoreInfo: string read fMoreInfo write fMoreInfo;
    property Load: integer read fLoad write fLoad;
  end;

var
  ServiceDiscoveryMainForm: TServiceDiscoveryMainForm;

implementation

uses
  uROTypes;

{$R *.dfm}

procedure TServiceDiscoveryMainForm.FormCreate(Sender: TObject);
begin
  ROBroadcastServer.Active := true;
  btn_UpdateServiceListClick(self);
end;

procedure TServiceDiscoveryMainForm.btn_UpdateServiceListClick(Sender: TObject);
begin
  RODiscoveryServer.ServiceList.Assign(ed_Services.Lines);
end;

procedure TServiceDiscoveryMainForm.btn_LookupServiceClick(Sender: TObject);
var
  lOptions: TMyDiscoveryQueryOptions;
begin
  lb_Servers.Items.Clear();

  RODiscoveryClient.ServiceName := ed_ServiceName.Text;

  lOptions := TMyDiscoveryQueryOptions.Create();
  try
    lOptions.MaximumLoad := StrToIntDef(ed_MaxLoad.Text,100); 
    RODiscoveryClient.RefreshServerList(lOptions);
  finally
    lOptions.Free();
  end;
end;

procedure TServiceDiscoveryMainForm.RODiscoveryClientNewServersFound(Sender: TObject);
begin
//  lb_Servers.Items.Assign(RODiscoveryClient.ServerList);
end;

procedure TServiceDiscoveryMainForm.RODiscoveryClientNewServiceFound(aSender: TObject; aName: String; aDiscoveryOptions: TRODiscoveryOptions);
var
  lOptions: TMyDiscoveryResultOptions;
begin
  if Assigned(aDiscoveryOptions) and (aDiscoveryOptions is TMyDiscoveryResultOptions) then begin
    lOptions := TMyDiscoveryResultOptions(aDiscoveryOptions);
    lb_Servers.Items.Add(Format('%s (Load: %d; Info: %s)',[aName, lOptions.Load, lOptions.MoreInfo]));
  end
  else begin
    lb_Servers.Items.Add(aName+' (no info)');
  end;
end;


procedure TServiceDiscoveryMainForm.cb_SupportRegisteredServerClassesClick(Sender: TObject);
begin
  RODiscoveryServer.SupportRegisteredServerClasses := cb_SupportRegisteredServerClasses.Checked;
end;

procedure TServiceDiscoveryMainForm.RODiscoveryServerServiceFound(aSender: TObject;
  aName: String; var ioDiscoveryOptions: TRODiscoveryOptions;
  var ioHandled: Boolean);
begin
  if Assigned(ioDiscoveryOptions) and (ioDiscoveryOptions is TMyDiscoveryQueryOptions) then begin
    { Check if we fullfill the load requirement. if our load is too high, abort
      without sending a response to the client }
    if TMyDiscoveryQueryOptions(ioDiscoveryOptions).MaximumLoad <= StrToIntDef(ed_ServerLoad.Text,100) then begin
      ROSendNoResponse();
    end;
  end;

  if cb_ReturnInfo.Checked then begin
    ioDiscoveryOptions := TMyDiscoveryResultOptions.Create;
    with TMyDiscoveryResultOptions(ioDiscoveryOptions) do begin
      Load := StrToIntDef(ed_ServerLoad.Text,-1);
      MoreInfo := 'Some info';
      ServerTime := Now;
    end;    { with }
  end
  else begin
    ioDiscoveryOptions := nil;
  end;

  { Don't free the original ioDiscoveryOptions (if it was assigned), the RO
    framework take scare of that, just as it will free the one we pass back }
end;

procedure TServiceDiscoveryMainForm.ActionListUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  ac_DiscoverServers.Enabled := not ROBroadcastChannel.Busy;
end;

initialization
  RegisterROClass(TMyDiscoveryQueryOptions);
  RegisterROClass(TMyDiscoveryResultOptions);
finalization
  UnregisterROClass(TMyDiscoveryQueryOptions);
  UnregisterROClass(TMyDiscoveryResultOptions);
end.