DataSnap的CallBack

DataSnap可以用TDBXCallBack的类进行服务端和客户端以及客户端与客户端之间的通信。

在进行通信时要用到以下标识

服务端与客户端通信：

    1.通道 

    2.客户端注册的回叫标识

客户端与客户端通信：

   1.通道

   2.客户端注册的回叫标识

   3.客户端标识

一个客户端一般只需要一个通道即可，一个通道可以注册多个客户端回叫标识，客户端标识主要用于客户端通信

开发时大体的步骤有以下几点：

1.服务端

     用DSServer的BroadcastMessage函数进行发送信息

function BroadcastMessage(const ChannelName: string; const Msg: TJSONValue;  const ArgType: Integer = TDBXCallback.ArgJson): Boolean; overload;
function BroadcastMessage(const ChannelName: string; const CallbackId: string;  const Msg: TJSONValue; const ArgType: Integer = TDBXCallback.ArgJson): Boolean; overload;

第一个函数时向ChannelName通道的所有在线客户端发送信息，第二个函数时向ChannelName通道的CallBackID的客户端发送信息，Msg是要发送的信息载体。

2.客户端

  主要用到了TDSClientCallbackChannelManager类和TDSAdminClient类（DSProxy单元）及TDBXCallBack类。

  1）.在工具箱是拖动DSClientCallbackChannelManager控件到窗体上，设置它的channelName\DSHostName\CommuncationProtocol\DSPort\ManagerID属性等，然后用它的RegisterCallback事件向服务器注册回叫标识即可。

 2） TDSAdminClient类主要用于向其它客户端发送信息，主要用到此类的NotifyCallback函数

function NotifyCallback(ClientId: string; CallbackId: string; Msg: TJSONValue; out Response: TJSONValue): Boolean; overload;
function NotifyCallback(ChannelName: string; ClientId: string; CallbackId: string; Msg: TJSONValue; out Response: TJSONValue): Boolean; overload; deprecated 'ChannelName is no longer required';

msg要发信息的载体，Response是接收放的应答信息，主要是用到了客户端的TDBXCallBack类，此类这些通信的基础。

3）TDBXCallBack是个虚函数，需用户重新产生一个子类并实现它的Execute的方法。服务端或客户端在通信时会把这个子类当做参数进行传递。

以下为开发实例的载图及其代码：（最上面的窗体为服务端，右边的为客户端在虚拟机中，左下边的为本机的客户端）

以下为开发大体步骤：

1.开发服务端

菜单"File-New-Other-DataSnap Server "建立服务端程序，主要在主窗体上放上以下几个控件：

两个listbox，主要获取客户端所有的回叫标识和客户端标识，两上TRadioButton用于发送信息时确认是给同一通道的客户发信息还是给指定的回叫标识发信息，这里主要用到了TJSONValue

以下为服务端主界面的源码

unit UFrmServer;

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    GroupBox2: TGroupBox;
    lbCallBackID: TListBox;
    btnAllCallBackID: TButton;
    edtMessage: TEdit;
    btnSend: TButton;
    rbAll: TRadioButton;
    rbSingle: TRadioButton;
    GroupBox1: TGroupBox;
    btnAllClientID: TButton;
    lbClientID: TListBox;
    procedure btnAllCallBackIDClick(Sender: TObject);
    procedure btnAllClientIDClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses ServerContainerUnit1,System.Generics.Collections,Data.DBXJSON;
{$R *.dfm}

const channel='test';

procedure TForm1.btnAllCallBackIDClick(Sender: TObject);   //获取所有通道的回叫标识
var
  ls:TList<string>;
  ea:TList<string>.TEnumerator;
begin
  lbCallBackID.Clear;
  ls:=ServerContainerUnit1.ServerContainer1.DSServer1.GetAllChannelCallbackId(channel);
  ea:=ls.GetEnumerator;
  while ea.MoveNext do
  lbCallBackID.Items.Add(ea.Current);
  ls.Free;
end;

procedure TForm1.btnAllClientIDClick(Sender: TObject);  //获取所有通道的客户端标识
var
  ls:TList<string>;
  ea:TList<string>.TEnumerator;
begin
  lbClientID.Clear;
  ls:=ServerContainerUnit1.ServerContainer1.DSServer1.GetAllChannelClientId(channel);
  ea:=ls.GetEnumerator;
  while ea.MoveNext do
    lbClientID.Items.Add(ea.Current);
  ls.Free;
end;

procedure TForm1.btnSendClick(Sender: TObject);   //发送信息
var
  js:TJsonString;
  callid:string;
begin
  js:=TJSONString.Create(edtMessage.Text);
  if rbAll.Checked then
    ServerContainer1.DSServer1.BroadcastMessage(channel,js)
  else
  begin
    callid:=lbCallBackID.Items.Strings[lbCallBackID.ItemIndex];
    if callid<>'' then
      ServerContainerUnit1.ServerContainer1.DSServer1.BroadcastMessage(channel,callid,js);

  end;

end;



procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if MessageDlg('你要关闭服务吗?',mtInformation,[mbYes,mbNo],0,mbno)=idno then
    CanClose:=False
  else
  begin
     if ServerContainerUnit1.ServerContainer1.DSServer1.Started then
       ServerContainerUnit1.ServerContainer1.DSServer1.Stop;
     CanClose:=True;
  end;

end;

end.

2.开发客户端

建立应用程序并在菜单"File-New-DataSnap Server"选择DataSnap Client Module选项，连接上面建立的服务程序并自动产生服务端的导出函数单元及DataModule类，在DataModule类上放TDSClientCallbackChannelManager控件，它主要用于向服务端注册回叫标识，另它的ManagerID是用于客户端的标识，千万不要忘记它的相关属性设置，否则其它电脑上的客户端是无法访问服务端的。

在客户端主界面上放以下控件：

TMemo:用于显示收到的信息

两个Combobox,让用户输入其它客户端的回叫ID和客户端标识ID，用于给其它客户端发信息

一个Tedit，用于写入要发送的信息内容，一个button用于发送动作

两个TEdit，主要是让程序在运行时让用户 输入客户端标识ID和客户端回叫ID。

一个Tbutton用于手动注册回叫事件

另加上一个TEdit，主要设置服务端的地址

以下为客户端主界面源码：

unit UMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Data.DBXJSON, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TFrmClient = class(TForm)
    GroupBox1: TGroupBox;
    mmReceive: TMemo;
    StatusBar1: TStatusBar;
    edtCallBack: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    edtServer: TEdit;
    GroupBox2: TGroupBox;
    edtSend: TEdit;
    btnSend: TButton;
    Label3: TLabel;
    Label4: TLabel;
    cbCallBack: TComboBox;
    cbClientID: TComboBox;
    label5: TLabel;
    edtClientID: TEdit;
    procedure btnSendClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure RegisterCallBackID;
    function ConnectServer:Boolean;
    procedure AddCombobox(const ClientID,CallID:string);
    procedure SendMsgToOtherClient;
  public
    { Public declarations }
  end;

type
  TDataSnapCallBack = class(TDBXCallback)
  private
    { private declarations }
  protected
    { protected declarations }
  public
    { public declarations }

    function Execute(const Arg: TJSONValue): TJSONValue;override;

  published
    { published declarations }
  end;


var
  FrmClient: TFrmClient;
  callid:string;
const
  channel='test';
implementation
 uses ClientModuleUnit1,Data.SqlExpr,Data.DBXCommon,Datasnap.DSProxy;
{$R *.dfm}

function TFrmClient.ConnectServer: Boolean;
begin
  Result:=false;


  with ClientModule1.SQLConnection1 do
  begin
    Params.Clear;
    with ConnectionData.Properties do
    begin
      Values[TDBXPropertyNames.DriverName]:='DataSnap';
      Values[TDBXPropertyNames.CommunicationProtocol]:='tcp/ip';
      Values[TDBXPropertyNames.HostName]:=edtServer.Text;
      Values[TDBXPropertyNames.Port]:='211';
      Values[TDBXPropertyNames.BufferKBSize]:='32';
      Values[TDBXPropertyNames.DatasnapContext]:='datasnap/';
    end;
    LoginPrompt:=False;
    try
      ClientModule1.SQLConnection1.Open;
      Result:=ClientModule1.SQLConnection1.ConnectionState=csStateOpen;
      ClientModuleUnit1.ClientModule1.DSClientCallbackChannelManager1.DSHostname:=edtServer.Text;//一定要设置
    except

    end;
  end;
end;

procedure TFrmClient.FormCreate(Sender: TObject);
begin

end;

{ TDataSnapCallBack }

function TDataSnapCallBack.Execute(const Arg: TJSONValue): TJSONValue;
var
  str:string;
begin
  Result:=TJSONString.Create('成功回叫客户端'); //一定要回传给服务端信息 ,在客户端发送时会显示
  if Assigned(Arg) then
    if (Arg is TJSONString) then
    begin
      str:=TJSONString(Arg).Value;
      TThread.Synchronize(nil,
                           procedure       //匿名方法
                           begin
                             FrmClient.mmReceive.Lines.Add(str);
                           end
                         );
    end;

end;

procedure TFrmClient.AddCombobox(const ClientID,CallID:string);
begin
  if cbClientID.Items.IndexOf(clientID)=-1 then
  cbClientID.Items.Add(ClientID);
  if cbCallBack.Items.IndexOf(CallID)=-1 then
  cbCallBack.Items.Add(CallID);
end;

procedure TFrmClient.btnSendClick(Sender: TObject);
begin
  SendMsgToOtherClient;
end;

procedure TFrmClient.Button1Click(Sender: TObject);
begin
  if (edtCallBack.Text='') or (edtClientID.Text='') then
  begin
    ShowMessage('请输入相关标识.');
    exit;
  end;


  RegisterCallBackID;
end;

procedure TFrmClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ClientModuleUnit1.ClientModule1.SQLConnection1.ConnectionState=csStateOpen then
  begin
    ClientModule1.DSClientCallbackChannelManager1.UnregisterCallback(callid);
    ClientModule1.SQLConnection1.Close;
  end;
end;

procedure TFrmClient.RegisterCallBackID;
var
  i:Integer;
begin
 // callid:=DateTimeToStr(now);
  AddCombobox(edtClientID.Text,edtCallBack.Text);
 callid:= edtCallBack.Text;
 ClientModule1.DSClientCallbackChannelManager1.ManagerId:=edtClientID.Text;
  if ConnectServer then
  begin
    StatusBar1.Panels[0].Text:='已成功连接服务器';

    if   ClientModule1.DSClientCallbackChannelManager1.RegisterCallback(callid,TDataSnapCallBack.Create) then
          StatusBar1.Panels[1].Text:='已成功注册,CallID:'+Callid
    else
      StatusBar1.Panels[1].Text:='注册CallID失败.';
  end else
  begin
   StatusBar1.Panels[0].Text:='连接服务器失败';
    i:=cbCallBack.Items.IndexOf(callid);
    cbCallBack.Items.Delete(i);     //删除注册失败的id
  end;
end;

procedure TFrmClient.SendMsgToOtherClient;
var
  AC:TDSAdminClient;  //发送消息管理类
  vMessage:TJSONString;
  outMessage:TJSONValue;
  clientID,CallbackID,sMessage:string;
begin
  if ConnectServer then
  begin
    clientID:=cbClientID.Text;
    CallbackID:=cbCallBack.Text;
    AC:=TDSAdminClient.Create(ClientModule1.SQLConnection1.DBXConnection,False);
    sMessage:=Format('呼叫通道: %s, 回叫识别: %s, 客户端标识: %s, 发送信息: %s',[channel,callbackid,clientid,edtSend.Text]);
    try
       vMessage:=TJSONString.Create(sMessage);
       try
         AC.NotifyCallback(channel,clientID,CallbackID,vMessage,outMessage);
         try
            if Assigned(outMessage) then
              mmReceive.Lines.Add(Format('返回信息： %s',[outmessage.ToString]))
            else
             mmReceive.Lines.Add('对方没有回应') ;
         finally
           outMessage.Free;
         end;

       finally
          vMessage.Free;
       end;

    finally
      AC.Free;
    end;

  end;

end;




end.

在XE3下开发，用tcp/ip

源码下载地址：http://download.csdn.net/detail/yagzh2000/5303997