Componentes.Terceros.RemObjects/internal/6.0.43.801/1/RemObjects Samples/RemObjects SDK for Delphi/BonjourDiscovery/fClientForm.pas

unit fClientForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClient, uROClientIntf, uRORemoteService, uROBinMessage, uROWinInetHTTPChannel,
  uROZeroConf, uROPoweredByRemObjectsButton, ExtCtrls, ComCtrls;

const
  UM_SYNCHRONIZE = WM_APP + 1;

type
  TSynchronizeMethod = procedure(Param: TObject);

  TSynchronizeMessage = packed record
     Msg: Cardinal;
     Routine: TSynchronizeMethod;
     Param: TObject;
     Result: Longint;
  end;

  TClientForm = class(TForm)
    ROMessage: TROBinMessage;
    ROChannel: TROWinInetHTTPChannel;
    RORemoteService: TRORemoteService;
    ROZeroConfBrowser: TROZeroConfBrowser;
    Panel1: TPanel;
    roButton: TROPoweredByRemObjectsButton;
    btUseService: TButton;
    lvServices: TListView;
    Label1: TLabel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Label2: TLabel;
    edLog: TMemo;
    btServiceInfo: TButton;
    procedure ROZeroConfBrowserServiceAdded(Sender: TROZeroConfBrowser;
      aRecord: TROZeroConfService);
    procedure ROZeroConfBrowserServiceRemoved(Sender: TROZeroConfBrowser;
      aRecord: TROZeroConfService);
    procedure btUseServiceClick(Sender: TObject);
    procedure btServiceInfoClick(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure LogMessage(const msg: string);
    procedure SetButtonsEnable;
    procedure HandleSynchronize(var Msg: TSynchronizeMessage); message UM_SYNCHRONIZE;
  public
    { Public declarations }
  end;

var
  ClientForm: TClientForm;

implementation

uses BonjourDiscoverableLibrary_Intf;

{$R *.dfm}

const
     LOCAL_SUFFIX = '.local.';
     NOT_RESOLVED = 'not resolved';

procedure TClientForm.LogMessage(const msg: string);
begin
     edLog.Lines.Add(msg);
     edLog.SelStart := Length(edLog.Lines.Text);
end;

procedure TClientForm.HandleSynchronize(var Msg: TSynchronizeMessage);
begin
     Msg.Routine(Msg.Param);
end;

procedure TClientForm.SetButtonsEnable;
begin
     btUseService.Enabled := lvServices.Items.Count > 0;
     btServiceInfo.Enabled := btUseService.Enabled;
end;

procedure ProcessServiceAdded(Param: TObject);
var aRecord: TROZeroConfService;
    newItem: TListItem;
    host: string;
begin
     aRecord := TROZeroConfService(Param);
     with ClientForm do begin
          Cursor := crHourGlass;
          LogMessage('Discovered new service: ' + aRecord.ServiceName);

          newItem := lvServices.Items.Add;
          newItem.Caption := aRecord.ServiceName;
          newItem.Data := aRecord;
          lvServices.ItemIndex := newItem.Index;
          SetButtonsEnable;

          if aRecord.TryResolve then begin
             host := StringReplace(aRecord.HostTarget, LOCAL_SUFFIX, '', [rfIgnoreCase]);
             LogMessage(Format('Service resolved. Host name: %s Port number: %d',
                               [host, aRecord.Port]));
             newItem.SubItems.Add(host);
             newItem.SubItems.Add(IntToStr(aRecord.Port));
          end
          else begin
             LogMessage('Service resolve failed!');
             newItem.SubItems.Add(NOT_RESOLVED);
             newItem.SubItems.Add(NOT_RESOLVED);
          end;
          Cursor := crDefault;
     end;
end;

procedure TClientForm.ROZeroConfBrowserServiceAdded(
  Sender: TROZeroConfBrowser; aRecord: TROZeroConfService);
begin
     SendMessage(Handle, UM_SYNCHRONIZE, integer(@ProcessServiceAdded), integer(aRecord));
end;

procedure ProcessServiceRemoved(Param: TObject);
var i: integer;
    aRecord, oldRec: TROZeroConfService;
begin
     aRecord := TROZeroConfService(Param);
     with ClientForm do begin
          LogMessage(Format('Service has gone down: %s (at host %s:%d)',
                            [aRecord.ServiceName,
                             StringReplace(aRecord.HostTarget, LOCAL_SUFFIX, '', [rfIgnoreCase]),
                             aRecord.Port]));
          for i := 0 to lvServices.Items.Count - 1 do begin
              oldRec := TROZeroConfService(lvServices.Items[i].Data);
              if (aRecord.ServiceName = oldRec.ServiceName) and
                 (aRecord.HostTarget = oldRec.HostTarget) and
                 (aRecord.Port = oldRec.Port)
              then begin
                  // Notice: oldRec is not Freed here, library will do it itself.
                  lvServices.Items.Delete(i);
                  SetButtonsEnable;
                  Break;
              end;
          end;
     end;
end;

procedure TClientForm.ROZeroConfBrowserServiceRemoved(
  Sender: TROZeroConfBrowser; aRecord: TROZeroConfService);
begin
     SendMessage(Handle, UM_SYNCHRONIZE, integer(@ProcessServiceRemoved), integer(aRecord));
end;

procedure TClientForm.btUseServiceClick(Sender: TObject);
var aRecord: TROZeroConfService;
    serv: IBonjourDiscoverableService;
begin
     aRecord := TROZeroConfService(lvServices.Items[lvServices.ItemIndex].Data);
     if aRecord.Resolved then begin
        ROChannel.TargetURL := Format('http://%s:%d/bin', [aRecord.Address, aRecord.Port]);
        serv := RORemoteService as IBonjourDiscoverableService;
        try
           LogMessage('---');
           LogMessage('Calling IntroduceMyself at URL ' + ROChannel.TargetURL);
           LogMessage('Got responce: ' + string(serv.introduceMyself('Delphi client')));
           LogMessage('Calling WhoAreYou. Server responds: ' + string(serv.WhoAreYou));
           LogMessage('Communication finished.');
           LogMessage('---');
        except
           on e: Exception do LogMessage('Exception was raised: ' + e.Message);
        end;
     end
     else LogMessage('Can''t connect to server - service was not resolved.');
end;

procedure TClientForm.btServiceInfoClick(Sender: TObject);
var aRecord: TROZeroConfService;
begin
     aRecord := TROZeroConfService(lvServices.Items[lvServices.ItemIndex].Data);
     if aRecord.Resolved
     then ShowMessage('Service provides aditional info:'#13#10 + aRecord.TextRecord)
     else ShowMessage('Additional info unavailable - service was not resolved.');
end;

end.