datasnap的进阶 TDSHTTPService的工作方式

TDSHTTPService继承自TDSHTTPServerTransport->TDSServerTransport。它的HttpServer是负责传输，HttpServer是TDSHTTPServerIndy类，这个类的FServer是IIPHTTPServer接口，实现该接口的是TIdHTTPServerPeer类，这个类的FHTTPServer是TIdHTTPServerIP，TIdHTTPServerIP继承自TIdHTTPServer，从而和indy发生关系。

和indy要发生关系，经过了

TDSHTTPService.HttpServer-> TDSHTTPServerIndy.FServer -> 
  IIPHTTPServer(TIdHTTPServerPeer).FHTTPServer -> TIdHTTPServerIP  -> TIdHTTPServer

目前TDSHTTPService并没有像TDSTCPServerTransport一样公布Indy的socket的OnConnect，OnDisconnect。所以要监视链接，得自己写代码。好在明白了上面的实现关系，代码就可以写成如下

(TDSHTTPServerIndy(DSHTTPService1.Server).Server as TIdHTTPServerPeer).FHTTPServer.OnConnect :=
  procedure(AContext: TIdContext)
  begin

  end;
或者
(TDSHTTPServerIndy(DSHTTPService1.Server).Server as TIdHTTPServerPeer).SetOnConnect(
  procedure(AContext: IIPContext)
  begin

  end
  );

遗憾的是，目前
方法1里Datasnap.DSHTTP单元的TDSHTTPServerIndy类并没有公开出来，TIdHTTPServerPeer的FHTTPServer是个私有变量
方法2里除了TDSHTTPServerIndy没公开外，TIdHTTPServerPeer的方法SetOnConnect是个protected。
上面的法子目前都不灵，只有走RTTI的hack方法来做。

在Datasnap.DSHTTP单元里，

procedure TDSHTTPServerIndy.InitializeServer;
begin
  FServer.UseNagle := False;
  FServer.KeepAlive := True;
  FServer.ServerSoftware := 'DatasnapHTTPService/2011';

  FServer.OnCommandGet := Self.DoIndyCommand;
  FServer.OnCommandOther := Self.DoIndyCommand;
end;

也就将TDSHTTPServerIndy.DoIndyCommand和TIdHTTPServer.OnCommandGet和TIdHTTPServer.OnCommandOther 给关联上了。目前的datasnap只关联了TIdHTTPServer的这两个事件。

剩下的就不必说了，TIdHTTPServer解析完了HTTP，给将数据给DoIndyCommand，DoIndyCommand再实施调度服务方法的工作。
TDSHTTPServer.DoCommand来进行任务分发工作，举其中一个类型JSON_CONTEXT来说明。

procedure TDSHTTPServer.DoJSONCommand(ARequestInfo: TDSHTTPRequest;
                                      AResponseInfo: TDSHTTPResponse;
                                      Request: String);
begin
  if FCredentialsPassThrough then
    JSONService := TDSJSONService.Create(FDSServerName, FDSHostname, FDSPort, ARequestInfo.AuthUserName, ARequestInfo.AuthPassword, IPImplementationID)
  else
    JSONService := TDSJSONService.Create(FDSServerName, FDSHostname, FDSPort, FDSAuthUser, FDSAuthPassword, IPImplementationID);

  SessionID := GetRequestSessionId(aRequestInfo, True);
   ...
        case CmdType of
        hcGET:
          JSONService.ProcessGETRequest(Request, nil, ByteContent(ARequestInfo.PostStream),
                                        RespHandler);
          hcPOST:
            JSONService.ProcessPOSTRequest(Request, nil, ByteContent(ARequestInfo.PostStream),
                                        RespHandler);
          hcPUT:
            JSONService.ProcessPUTRequest(Request, nil, ByteContent(ARequestInfo.PostStream),
                                        RespHandler);
          hcDElETE:
            JSONService.ProcessDELETERequest(Request, nil, ByteContent(ARequestInfo.PostStream),
                                        RespHandler);
          else
          begin
            GetInvocationMetadata().ResponseCode := 501;
            GetInvocationMetadata().ResponseContent := Format(SCommandNotSupported, [ARequestInfo.Command]);
          end;
        end;
   ...
    if RespHandler = nil then
      FreeAndNil(JSONService);

    if RespHandler <> nil then
      RespHandler.Close;
  end;
end;

  constructor TDSService.Create(dsServerName, dsHostname: String; dsPort: Integer; AuthUser, AuthPassword, AIPImplementationID: String);
  begin
    inherited Create;
    FDBXProperties := TDBXDatasnapProperties.Create(nil);
    if DSServerName = EmptyStr then  //没指定了TDSHTTPService的Server时，就是用DSHostname, DSport建立DBXConnection，调用远程方法
    begin
      FDBXProperties.Values[ TDBXPropertyNames.DriverName ] := DRIVER_NAME;
      FDBXProperties.Values[ TDBXPropertyNames.HostName ] := dsHostname;
      FDBXProperties.Values[ TDBXPropertyNames.Port ] := IntToStr( dsPort );
      FLocalConnection := false; //不是本地连接
    end
    else
    begin  
      FDBXProperties.Values[ TDBXPropertyNames.DriverName ] := DSServerName; //指定了TDSHTTPService的Server时，就是自己的本地服务方法调用
      FLocalConnection := true; //是本地的
    end;
    FDBXProperties.DSAuthUser := AuthUser;
    FDBXProperties.DSAuthPassword := AuthPassword;
    FDBXProperties.Values[ TDBXPropertyNames.IPImplementationID ] := AIPImplementationID;

    StreamAsJSON := False;
  end;

可以看到DoJSONCommand里面，新建立一个TDSService，然后执行了TDSService.Execute。也就是说，每次的HttpRequest请求，TDSHTTPServer都会建立一个全新的DBXConnection，连上TDSHTTPService的DSHostname,DSPort指向的Server，然后执行完毕后断开DBXConnection连接，释放TDSService。这也就解释了前面说的用TDSHTTPService来做负载和容错，可以靠DSHostname,DSPort来做的原因： TDSHTTPService只是剥离了HTTP的外衣，然后自己当客户端调用了服务罢了

Delphi Spring Framework

将我比较常用或关注的资源分享

jedi，太有名了，以前的ide的about都有他的彩蛋
http://www.delphi-jedi.org/


Delphi Spring Framework，看名字就明白
http://code.google.com/p/delphi-spring-framework/

MQ相关的
http://www.habarisoft.com/

scalemm，内存管理器，自称比FastMM还快
http://code.google.com/p/scalemm/

EMBT的博客
http://blogs.embarcadero.com/

OmniThreadLibrary，一个多线程库，很不错的
http://otl.17slon.com/

AsyncCalls
http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/

datasnap的进阶 传递自定义类型的类

前面我写了一个返回自定义类的例子，将要返回的类marshal后装进TJSONArray，今天看来真是多余，因为datasnap的对自定义类的marshal做得很自动，直接返回就行。
前面我定义了

type
  TPerson = class
    FirstName: string;
    LastName: string;
    Age: Integer;
  end;
  TPersonArray = array of TPerson; 

然后写了服务方法

function TServerMethods1.GetPersons: TJSONArray; 

这样写没问题，如果直接写成

function TServerMethods1.GetPersons: TPersonArray;

是不可以的，因为TPersonArray不是类，它的TTypeInfo的TypeKind不是tkClass而是tkDynArray，目前是不datasnap支持的。
于是可以写一个集合类

  TPersonCollection = class
  private
    FPersons: TArray;
  public
    destructor Destroy; override; //别忘了free掉元素
    property Persons: TArray read FPersons write FPersons;
  end;

然后写服务方法

function TServerMethods1.GetPersons: TPersonCollection;

这样就可以了，服务器端可以直接写，客户端可以直接读，不用自己去marshal和unmarshal了。

那是不是说，我们的Field只要封到类里就一定ok呢，不是的。
将上面的类修改为如下

  TPerson = class
    FirstName: string;
    LastName: string;
    Age: Integer;
    Birthday: TDateTime;
    Memo: TStringList;
  end;

TDateTime其实是一个double类型，在datasnap里面是被支持的，TStringList却不行了。但是如果客户端是其他语言REST来的，TDataTime在客户端就难被解释了。怎么办呢
其实Datasnap里，我们可以自己定义marshal的规则。
XE2里面，有两个类TConverterEvent给编码，和TReverterEvent来解码。给EMBT封装后，用法也很简单。

var
  DateTimeDecodeFunc: TStringReverter;
  DateTimeEncodeFunc: TStringConverter;
procedure RegisterReverterConverters;
var
  decode: TReverterEvent;
  encode: TConverterEvent;
begin
  DateTimeEncodeFunc := function(Data: TObject; Field: string): string
    var
      ctx: TRttiContext;
      date: TDateTime;
    begin
      date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType;
      Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', date);
    end;
  DateTimeDecodeFunc := procedure(Data: TObject; Field: string; Arg: string)
    var
      ctx: TRttiContext;
      datetime: TDateTime;
    begin
      datetime := EncodeDateTime(StrToInt(Copy(Arg, 1, 4)), //yyyy
        StrToInt(Copy(Arg, 6, 2)), //mm
        StrToInt(Copy(Arg, 9, 2)), //dd
        StrToInt(Copy(Arg, 12, 2)),//hh
        StrToInt(Copy(Arg, 15, 2)),//nn
        StrToInt(Copy(Arg, 18, 2)),//ss
        0);
      ctx.GetType(Data.ClassType).GetField(Field).SetValue(Data, datetime);
    end;

  decode := TReverterEvent.Create(TPerson, 'Birthday');
  decode.StringReverter := DateTimeDecodeFunc;
  TJSONConverters.AddReverter(R);

  encode := TConverterEvent.Create(TPerson, 'Birthday');
  encode.StringConverter := DateTimeEncodeFunc;
  TJSONConverters.AddConverter(encode);
end;

简单的说，就是定义转换规则后，加给TJSONConverters，让TJSONConverters知道要这么转换来转换回去。 至于TStringList的转换，道理明白了，所以也一样可以写了。Delphi2010的DataSnap可以看这里。 转换的一些普通的函数，EMBT已经提供得有。在Data.DBXJSONReflect单元里，能找到

/// 
Converts a TStringList into a TSerStringList
function StringListConverter(Data: TObject): TObject;
/// 
Reverts a TSerStringList into a TStringList
function StringListReverter(Ser: TObject): TObject;
/// converts the pair list of a JSON Object into a serializable structure
function JSONObjectPairListConverter(Data: TObject; Field: String): TListOfObjects;
function JSONArrayElementsConverter(Data: TObject; Field: String): TListOfObjects;
procedure JSONObjectPairListReverter(Data: TObject; Field: String; Args: TListOfObjects);
procedure JSONArrayElementsReverter(Data: TObject; Field: String; Args: TListOfObjects);

除了这个方法，XE2里面另外还用到了描述类，来自动告诉JSON怎么转换。
将上面的TPerson修改为

 TPerson = class
    FirstName: string;
    LastName: string;
    Age: Integer;
    [JSONReflect(ctString, rtString, TDateTimeInterceptor, nil, True)] 
    Birthday: TDateTime;
    Memo: TStringList;
  end;

给Birthday增加描述，JSONReflect是个描述类，继承自TCustomAttribute。
看JSONReflect的代码

 
   constructor Create(ConverterType: TConverterType;
      ReverterType: TReverterType; InterceptorType: TClass = nil;
      PopulationCustomizerType: TClass = nil;
      IsMarshalOwned: boolean = false); overload;

  TConverterType = (ctObjects, ctStrings, ctTypeObjects, ctTypeStrings,
    ctObject, ctString, ctTypeObject, ctTypeString); 
  TReverterType = (rtObjects, rtStrings, rtTypeObjects, rtTypeStrings, rtObject,
    rtString, rtTypeObject, rtTypeString);

这几种类型
顾名思义，
第一个参数是表示进去的数据类型，
第二个是出来的类型，
第三个是执行转换的类，必须从TJSONInterceptor继承
第四个先不管，必须从TJSONPopulationCustomizer继承
第五个表示了是否拥有创建出来的类

目前只管写第3个执行转换的类。由于我们只是要转字符串，所以只覆盖字符的转换就行。

  TDateTimeInterceptor = class(TJSONInterceptor)
  public
    function StringConverter(Data: TObject; Field: string): string; override;
    procedure StringReverter(Data: TObject; Field: string; Arg: string); override;
  end;

怎么转换，和上面的一样的了。我是觉得这个方法比上面的法子好。

datasnap的进阶 TDSHTTPService的用法

我一直觉得datasnap不适合做REST，因为http的东西用indy来做容器，承受力差了点是一方面，另外最主要的是比起java的世界delphi代码不好解耦（VCL for Web没人用我想这也是个主要原因吧）。今天看TDSHTTPService，觉得这个控件还是有点妙用。

普通情况下TDSHTTPService挂这个DSServer，以发布要公布的服务方法。这是应该有的功能。

我这里想说的是TDSHTTPService不挂DSServer，设置DSHostname 和DSPort后居然可以做转发。
有了这个功能，我们就能做一个简单的容灾切换(Failover)：前面一个机器D，提供http的服务，程序收到请求后，直接通过tcp连接后面真正干活的机器A的服务方法； 如果机器A不行了，修改DSHostname 和DSPort，将请求转发到机器B。看到这里是不是想datasnap要是能做简单集群就好了，其实也是应该可行的：既然能转发，那么根据一定规则将请求转发到不同机器上好了。

这样相对来说，datasnap来做服务，就算是简单的容灾啦，进一步如果机器A好了，要切回去， 也应该没问题。


切题时，HTTP Session在机器D上面，还得注意Session的延续。要延续Session，就要看TDSHTTPService的实现Session的方法。

TDSHTTPService其实是个Transport，只负责传输的，当然由于是http的，他得负责解析http。实现http解析的是TDSHTTPService的HttpServer，是TDSHTTPServer类，负责解析Http。TDSHTTPServer有一个属性TunnelService，是TDSTunnelService类，它具体的负责从Http流里Session的读取写入，截取TDSTunnelService的事件，来做Session的延续。

XE2里EMBT提供了一个Failover的例子，可以参考。

不过TDSHTTPService的具体实现思路我还没弄清楚，它是如何转发的还待看代码。

匿名方法转换为对象方法

前面说TDSServerClass是提到一个问题，就是匿名方法如何转换为对象方法

比如我想写的代码是

procedure TForm11.FormCreate(Sender: TObject);
begin
  Button1.OnClick ：= procedure(Sender: TObject)
    begin
      ShowMessage('Button1 Clicked');
    end;
end;

这样直接编译不过去，因为一个是函数引用，是个是对象方法
函数引用 reference to procedure（Sender: TObject）
对象方法 procedure(Sender: TObject) of object;

带着疑问拜google，得到下面的解决方法，连接地址

procedure TForm11.FormCreate(Sender: TObject);
begin 
  @Button1.OnClick := PPointer(Cardinal(PPointer(
    procedure(Sender: TObject)
    begin
      ShowMessage('Button1 Clicked');
    end
    )^) + $0C)^;
end;

很神奇，原理是说 匿名函数被编译器编译成了一个接口类，$0C的地址所指，也就是接口类的VMT IUnknow第4个函数的入口(前三个是QueryInterface,_AddRef,_Release,TInterfacedObject实现)。因为都是对象方法，所以不用转换，只是将函数入口地址赋值即可。
我写代码测试了几次，能得出一个结论，在一个函数内定义的函数引用类型变量，会编译成“函数名$ActRec”的类(姑且叫ActRec)，并只产生一个ActRec的实例，每个函数引用变量就对应着一个接口，有几个函数变量，就会有几个接口，然后这个ActRec都会实现这几个接口。


但是如果匿名函数太长，单独定义写呢

procedure TForm11.FormCreate(Sender: TObject);
type
  TNotifyProc = reference to procedure(Sender: TObject); 
  TNotifyXXX = reference to procedure(a: Integer; b: Integer); 
var
  B1，B2: TNotifyPro;
  Bi: Interface;
  Bo: TObject;
  xxx: TNotifyXXX; 
begin
  B1 := procedure(Sender: TObject)
    begin
      ShowMessage('Button1 Clicked'); 
    end;
  B2 := procedure(Sender: TObject)
    begin
      ShowMessage('Button1 Clicked'); 
    end;
  xxx := procedure(a: Integer; b: Integer)
    begin
      ShowMessage('xxx'); 
    end;

  Bi := PUnknown(@B1)^;    //函数引用其实是个接口来的
  Bo := Bi as TObject;       //将接口转为为实体类
  showmessage(Bo.ClassName); //TForm11.FormCreate$ActRec，该类实现了3个接口

  @Button1.OnClick := PPointer(Cardinal(PPointer(
    Integer(Bi) //可行
    )^) + $0C)^;

  @Button1.OnClick := PPointer(Cardinal(PPointer(
    PInteger(@B1)^ //可行
    )^) + $0C)^;

  @Button1.OnClick := PPointer(Cardinal(PPointer(
   Bo.GetInterfaceTable^.Entries[0].VTable //这样不行，为啥？？？？
    )^) + $0C)^;end;

难道接口变量已经不是指向VTable所指了？？？？
不过这种靠编译器的，毕竟不是好方法，继续找找看。

一些小技巧 枚举和字符串的转换

因为一直用，想写个函数封起来却没成功，编译不过，郁闷

TEnumUtil = class
  public
     class function EnumToStr(E: T): string;
     class function StrToEnum(S: string): T;
  end;

{ TEnumUtil }

class function TEnumUtil.EnumToStr(E: T): string;
begin
  Result := GetEnumName(TypeInfo(T),Ord(E));
end;

class function TEnumUtil.StrToEnum(S: string): T;
begin
  Result := T(GetEnumValue(TypeInfo(T), S));
end;

//20111028，终于搞定

TEnumUtil = class
public
  class function EnumToStr(e: T): string;
  class function StrToEnum(s: string): T;
end;

class function TEnumUtil.EnumToStr(e: T): string;
begin
  Result := GetEnumName(TypeInfo(T), PByte(@e)^);
end;

class function TEnumUtil.StrToEnum(s: string): T;
var
  i: Byte;
  p: Pointer;
begin
  i := GetEnumValue(TypeInfo(T), s);
  p := @i;
  Result := T(p^);
end;

datasnap的进阶 异步服务调用

想写这个文章，但是却发现datasnap没这功能，毕竟datasnap不是基于消息的（但是RO框架却有的），郁闷。

要实现异步服务调用，参考RO的设计，可这么来实现一个同RO一样的假的异步
1。客户端，Call服务方法时，不在主线程里，新起一个线程去Call，等待放在了线程里。
2。客户端，变成多线程了，为了不阻塞自身的调用，所以线程去Call，应该SQLConnection1.CloneConnection出来一个连接去单独做这个事情。就算是Clone出来的，也是新起的连接，服务端的Session是新Session，服务端的服务方法也是新new出来的服务类(Session模式下)，所以状态是不一样的，要注意。
还有一个想法是用异步socket来实现，但是感觉和indy有些冲突，以后再谈

这样的实现，也是有自身的问题，毕竟客户端还是在等待服务端的执行完毕。 很多时候，我们只是在客户端触发一个事情，将触发内容通知给服务器，而客户端并不需要等待服务器执行完毕，服务器自身跑上20分，30分后自己退出（比如手动执行系统维护）。在datasnap里要解决这个问题，就应该在服务器的服务方法里下手了：
1。 服务方法里，自己启动自销毁线程(FreeOnTerminate=True)，线程去做事，服务方法自己返回。

我这里说到的两个情况，如果EMBT的datasnap框架能自己封装进去，我想将会是件很好的事(异步同步和服务自身没关系，只和客户端的调用方法有关），WCF都能异步同步都玩转啊

datasnap的进阶 TDSServerClass

TDSServerClass这个控件是很简单，最熟悉不过的是下面的代码，它的OnGetClass事件里加上我们的服务器方法类

procedure TServerContainer1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;

问题是：一般的真实应用里，我们的服务方法类会有很多，岂不是要在TServerContainer里面放很多个 TDSServerClass？？？ 并且还要去写它的OnGetClass类方法

要想解决这个问题，我们还是的理解TDSServerClass到底是干嘛的，为啥EMBT这么设计了。

datasnap里面，TDSServer是老大，它靠TDSTCPServerTransport来负责通讯， 至于根据通讯来触发的什么服务器方法，就靠TDSServer了。TDSServer将它所拥有的TDSServerClass的TPersistentClass的服务方法都给存起来，代码在
DSCommonServer.pas的

procedure TDSServerMethodProvider.AddRegisteredServerClasses;
var
  List: TDBXArrayList;
  Index: Integer;
  Count: Integer;
  ServerClass: TDSCustomServerClass;
  ClassInfo: TDSClassInfo;
  DsClass: TDSClass;
  AdapteeClass: TDSClass;
  ClassName: UnicodeString;
begin
  List := TDBXArrayList.Create;
  try
    FServer.GetServerClassList(List);//取得DSServer关联着的TDSServerClass列表
    Count := List.Count;
    for index := 0 to Count - 1 do
    begin
      ServerClass := TDSCustomServerClass(List[Index]);
      DsClass := ServerClass.DSClass; //这里触发了通过GetDSClass函数触发OnGetClass事件
      ClassName := DsClass.DSClassName;
      AdapteeClass := DsClass.AdapteeDSClass;
      if AdapteeClass <> nil then
        ClassName := AdapteeClass.DSClassName;
      ClassInfo := TDSClassInfo.Create;
      ClassInfo.ServerClass := ServerClass;
      ClassInfo.DSClassName := ClassName;
      ClassInfo.LifeCycle := ServerClass.LifeCycle;
      ClassInfo.RoleName := ServerClass.RoleName;
      ClassInfo.DSClass := DsClass;
      AddServerClass(ClassInfo);//存起来
      AddAllMethods(ClassInfo); //存起来
    end;
  finally
    FreeAndNil(List);
  end;
end;

进一步查看代码知道，TDSServerClass的GetDSClass是可以重载的

function GetDSClass: TDSClass; override;

因此，如果我们自己要写很多服务方法类时，可以自己写一个注册服务方法的类，也就是直接覆盖GetDSClass就可以了，那样就不必写什么OnGetClass事件并去关联事件(这里另一个想法是，要关联事件，直接用匿名函数去关联，这样就不必为了关联而单独定义一个类方法，但是匿名函数只是一个方法，而不是对象方法，也要让MakeObjectInstance反向？等几天测测)。

简单的代码如下

{$METHODINFO ON} 
TMyServerMethod = class
end;
{$METHODINFO OFF}
TServerMethodA = class(TMyServerMethod )
   function ServerMethodA1: Integer;
   function ServerMethodA2: Integer;   
end; 

TServerMethodB = class(TMyServerMethod)
   function ServerMethodB1: Integer;
   function ServerMethodB2: Integer;   
end;

TMyDSServerClass=class(TDSServerClass)
  private
    FPersistentClass: TPersistentClass;
  protected
    function GetDSClass: TDSClass; override;
  public
    constructor Create(AOwner: TComponent; AServer: TDSCustomServer; AClass: TPersistentClass); reintroduce;overload;
  end;

constructor TMyDSServerClass.Create(AOwner: TComponent; AServer: TDSCustomServer; AClass: TPersistentClass);
begin
  inherited Create(AOwner);
  FPersistentClass := AClass;
  Self.Server := AServer;
end;

function TMyDSServerClass.GetDSClass: TDSClass;
begin
  Result := TDSClass.Create(FPersistentClass, False);
end;

然后，我们要注册服务方法类时，写个注册函数

procedure RegisterServerClasses(AOwner: TComponent; AServer: TDSServer);
begin
  TMyDSServerClass.Create(AOwner, AServer, TServerMethodA );
  TMyDSServerClass.Create(AOwner, AServer, TServerMethodB);
end;

有了这个函数，我们以后写代码，就可以自己专注写服务方法类，写完了再在这里增加一行代码就行了，代码不用拥挤到一个ServerContainerUnit1里，不好维护。

当然，DSServer还有LifeCycle的属性，可以添加后，覆盖CreateInstance和DestroyInstance两个方法

delphi的一些语法1

strict
Delphi没有友元，因为同一个Unit的，是可以访问别的类的Private或者Protected变量的，也就是默认就友元了。要让同一个Unit的不友元，就要用到strict。
比如同一个Unit里

TA = class
  private
    p1: Integer;
  protected
    p2: Integer;
  strict private
    p3: Integer;
  strict protected
    p4: Integer;
  end;
  TB = class
    procedure showTA(a: TA);
  end;

procedure TB.showTA(a: TA);
begin
  showmessage(inttostr(a.p1));//ok
  showmessage(inttostr(a.p2));//ok
  showmessage(inttostr(a.p3));//error
  showmessage(inttostr(a.p4));//error
end; 

datasnap的初步 TDSClientCallbackChannelManager的工作方式

理解一下TDSClientCallbackChannelManager的工作方式吧

客户端调用RegisterCallback，其实就是开始了一个线程TDSChannelThread，该线程起一个dbxconnection，连接到服务器上，执行DSAdmin.ConnectClientChannel，服务器上的这个DSAdmin.ConnectClientChannel很神奇，所有的数据传输都在这里了，这个连接不会关闭，以做到服务器往客户端push数据。TDSClientCallbackChannelManager只能做到服务器向客户端推送数据，单向的。客户端要向服务器送数据，走TDSAdminClient的NotifyCallback方法，也就是只有经过SQLConnection。

DSAdmin（在Datasnap.DSCommonServer单元）是TDBXServerComponent(在Datasnap.DSPlatform单元)的子类，ConnectClientChannel函数直接call ConsumeAllClientChannel。
代码摘抄

function TDBXServerComponent.ConsumeAllClientChannel(const ChannelName,
  ChannelId, CallbackId, SecurityToken: String; ChannelNames: TStringList;
  ChannelCallback: TDBXCallback; Timeout: Cardinal): Boolean;
... 
begin

        // wait for exit message
        repeat  //这里开始
          Data := nil;
          IsBroadcast := false;
          ArgType := TDBXCallback.ArgJson;

          QueueMessage := nil;

          TMonitor.Enter(CallbackTunnel.Queue);
          try
            {Wait for a queue item to be added if the queue is empty, otherwise
             don't wait and just pop the next queue item}
            if CallbackTunnel.Queue.QueueSize = 0 then
              IsAquired := TMonitor.Wait(CallbackTunnel.Queue, Timeout)
            else
              IsAquired := true;

            if IsAquired and (CallbackTunnel.Queue.QueueSize > 0) then
            begin
              {Get the next queued item from the tunnel}
              QueueMessage := CallbackTunnel.Queue.PopItem;
              Data := QueueMessage.Msg;
              IsBroadcast := QueueMessage.IsBroadcast;
              ArgType := QueueMessage.ArgType;
            end;
          finally
            TMonitor.Exit(CallbackTunnel.Queue);
          end;

          if IsAquired and (Data <> nil) then
            if IsBroadcast then
            begin
              try
                Msg := TJSONObject.Create(TJSONPair.Create('broadcast',
                                                          TJSONArray.Create(Data).Add(ArgType)));
                if (QueueMessage.ChannelName <> EmptyStr) and
                   (QueueMessage.ChannelName <> CallbackTunnel.ServerChannelName) then
                  Msg.AddPair(TJSONPair.Create('channel', QueueMessage.ChannelName));

                try
                  ChannelCallback.Execute(Msg).Free;
                except
                  try
                    // Remove the callback tunnel from the list, it will be freed at the end of this method
                    InternalRemoveCallbackTunnel(DSServer, CallbackTunnel);
                  except
                  end;
                  raise;
                end;
              finally
                QueueMessage.InstanceOwner := false;
                FreeAndNil(QueueMessage);
              end;
            end
            else if Assigned(QueueMessage) then
            begin
              TMonitor.Enter(QueueMessage);
              try
                Msg := TJSONObject.Create( TJSONPair.Create('invoke',
                       TJSONArray.Create( TJSONString.Create(QueueMessage.CallbackId),
                                          Data).Add(ArgType)));
                try
                  QueueMessage.Response :=  ChannelCallback.Execute(Msg);
                except
                  on E : Exception do
                  begin
                    QueueMessage.IsError := True;
                    QueueMessage.Response := TJSONObject.Create(TJSONPair.Create('error', E.Message));
                    if ChannelCallback.ConnectionLost then
                    begin
                      WasConnectionLost := True;
                      TMonitor.Pulse(QueueMessage);
                      try
                        // Remove the callback tunnel from the list, it will be freed at the end of this method
                        InternalRemoveCallbackTunnel(DSServer, CallbackTunnel);
                      except
                      end;
                      Break;
                    end;
                  end;
                end;
                TMonitor.Pulse(QueueMessage);
              finally
                TMonitor.Exit(QueueMessage);
              end;
            end
        until (not IsAquired) or (Data = nil); //这里结束
...
end.

客户端调用UnregisterCallback，调用的线程(一般就是主线程)，直接起一个dbxconnection，让服务器执行DSAdmin.UnregisterClientCallback，执行后立刻dbxconnection.close， 服务器执行UnregisterClientCallback只是剔除消息筛选；

如果客户端没有订阅别的Callback，就再次起一个dbxconnection，让服务器执行DSAdmin.CloseClientChannel，服务器的CloseClientChannel里，会往CallbackTunnel广播一个nil的消息，这就让ConnectClientChannel的repeat循环也会退出(data=nil)，从而关闭最开始连接。


另外， TDSClientCallbackChannelManager在界面上找不到输入认证信息的地方，比如DSAuthPassword, DSAuUser等，其实TDSClientCallbackChannelManager也好SQLConnection也好，他们都是个载体罢了，真正在后面起作用的，是TDBXProperties。监视一下DSServer的OnConnect里的DSConnectEventObject.ConnectProperties，我们就能知道TDSClientCallbackChannelManager的username, password，其实是SQLConnection的DSAuthPassword，DSAuUser。
在TDBXProperties里的键值对为
DSAuthenticationUser=
DSAuthenticationPassword=

最后，TDSClientCallbackChannelManager并没有Filters的属性，这个其实现在的客户端，就算使用SQLConnection时也不必设置Filters了，我们只要别忘记在客户端也TTransportFilterFactory.RegisterFilter一下要用的Filter即可。

函数引用的内存泄漏

今天发现一个bug，已经提交到QC。http://qc.embarcadero.com/wc/qcmain.aspx?d=100132

datasnap的初步 LogInfo的内存泄漏

前面写的LogInfo，有内存泄漏，原因不明，漏8byte

 修改为

function LogInfo(msg: UTF8String): Boolean;
var
  p: PAnsiChar;
  len: Integer;
begin
  len := Length(msg);
  GetMem(p, len + 1);
  Move(msg[1], p^, len);
  p[len] := #0; //for wm_log's freemem
  PostMessage(Form1.Handle, WM_LOG, WPARAM(p), len + 1);
end;
procedure TForm1.WM_Log(var msg: TMessage);
var
  p: PAnsiChar;
begin
  p := PAnsiChar(msg.WParam);
  Form1.Memo1.Lines.Add(p);
  FreeMem(p, msg.LParam);
end;

仍然泄漏，原因不明，仍然漏8byte

难道时代变了，在线程A里面GetMem的，不能在线程B里FreeMem了？

但是我把这些代码，单独拿出来，放在一个Proejct里测试时，同样在线程A里Get，在线程B里Free，却没有问题，真让人费解。不知道datasnap的框架里到底搞了什么。

datasnap的初步 我用到的LogInfo函数

目前我的代码里面一直用到的LogInfo函数，其实很简单。就是服务器的Form里面放了一个TMemo，Memo里面记录下来消息，方面查看。
代码如下

TForm1 = class(TForm)
    Memo1: TMemo;
    procedure WM_Log(var msg: TMessage); message WM_LOG; 

procedure TForm1.WM_Log(var msg: TMessage);
var
  p: PChar;
begin
  p := PChar(msg.WParam);
  Form1.Memo1.Lines.Add(p);
  FreeMem(p, msg.LParam);
end;

function LogInfo(msg: string): Boolean;
var
  p: PChar;
  len: Integer;
begin
  //Form1.Memo1.Lines.Add(msg);
  len := Length(msg);
  GetMem(p, (len + 1) * SizeOf(Char));
  Move(msg[1], p^, len * SizeOf(Char));
  p[len] := #0; //for wm_log's freemem
  PostMessage(Form1.Handle, WM_LOG, WPARAM(p), (len + 1) * SizeOf(Char));
end;

前面我提到了，尽量不要在TIdThreadWithTask线程里去修改VCL的东西，如果要修改，也要通过发消息来修改，不要直接去修改，否则容易和主线程发生死锁。
 比如如果我的LogInfo函数直接写成

function LogInfo(msg: string): Boolean;
Form1.Memo1.Lines.Add(msg); 
end; 

会有什么问题呢，可以假想，点击Form1右上角的X关闭程序是，将关闭所有线程，线程关闭时如果我们有LogInfo('')，那么这个LogInfo就会直接操作主线程VCL，而主线程正等待其他线程的退出呢，从而可能死锁(因为VCL是以Windows消息来驱动的，主线程正等待所以消息处理不到)。

好，到这里，或许说加上TThread.Synchronize来搞就可以，其实也是不行的。TThread.Synchronize只是切题线程运行让TThreadMethod的内容给主线程执行罢了，以避免多线程的同步问题。上面的情况，主线程正等待子线程结束，子线程结束时说，我要切题到主线程记一下Log再退出，可主线程正等呢，切不过去，就死锁了，所以加上TThread.Synchronize更容易死锁。

datasnap的初步 Session的管理

Datasnap的session管理是强制的，没有选项能说不要。
管理靠一单例TDSSessionManager来管理。对于目前说到TDSTCPServerTransport，建立的的Session为TDSTCPSession，它是TDSSession的子类。

Session在开始连接后，就创建了，再连接断开后消亡。

 TDSSession = class
  private
    FStartDateTime: TDateTime;   /// creation timestamp
    FDuration: Integer;          /// in miliseconds, 0 for infinite (default)
    FStatus: TDSSessionStatus;   /// default idle
    FLastActivity: Cardinal;     /// timestamp of the last activity on this session
    FUserName: String;           /// user name that was authenticated with this session
    FSessionName: String;        /// session name, may be internally generated, exposed to 3rd party
    FMetaData: TDictionary; /// map of metadata stored in the session
    FMetaObjects: TDictionary; /// map of objects stored in the session
    FUserRoles: TStrings;        /// user roles defined through authentication
    FCache: TDSSessionCache;
    FLastResultStream: TObject;  /// Allow any object which owns a stream, or the stream itself, to be stored here
    FCreator: TObject;           /// Creator of the session object reference

可以看出，Session可以用存储了很多东西 。用得多的是FMetaData与FMetaObjects
对于字符串，PutData放进去，GetData取出来；对于Object，PutObject放进去，GetObject取出来。
使用方法为

TDSSessionManager.GetThreadSession.PutData('userid', userId);
userId := TDSSessionManager.GetThreadSession.GetData（'userid'）;

另外，放入FMetaObjects的Object，Session的Free时，会自动帮忙Free，所以不必自己去Free的。

关于Session的超时，
这里自然就想到了TDSTCPServerTransport的KeepAliveInterval和KeepAliveTime属性，这两个属性，其实和Session管理没关系。
跟踪代码，这两个属性的反应在IdStackWindows.pas的

procedure TIdStackWindows.SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  const AEnabled: Boolean; const ATimeMS, AInterval: Integer);
var
  ka: tcp_keepalive;
  Bytes: DWORD;
begin
  // SIO_KEEPALIVE_VALS is supported on Win2K+ only
  if AEnabled and (Win32MajorVersion >= 5) then
  begin
    ka.onoff := 1;
    ka.keepalivetime := ATimeMS;
    ka.keepaliveinterval := AInterval;
    WSAIoctl(ASocket, SIO_KEEPALIVE_VALS, @ka, SizeOf(ka), nil, 0, @Bytes, nil, nil);
  end else begin
    SetSocketOption(ASocket, Id_SOL_SOCKET, Id_SO_KEEPALIVE, iif(AEnabled, 1, 0));
  end;
end;

里，其实就是简单设置了一下socket fd的属性，所以说TDSSessionManager毛关系都没有。

另外， KeepAliveTime默认值为300000，也就是300秒，KeepAliveInterval默认值为100，这是啥意思呢。KeepAliveTime是sockfd最后一次通讯后，等待了的时间，如果300秒内没通讯，socket栈就自己开始发送心跳探测了，如果每次都没回答，就每隔KeepAliveInterval毫秒问一次。至于问多少次认为是网络断开了，根据Windows OS来定的，windows 2000, 2003是5次，vista以后问10次。也就是说，根据TDSTCPServerTransport的默认设定，网络断了，在win7上，要300+0.1*10，也即是301秒才知道网络断了。
OS的系统设定更长，没数据通讯后2小时才开始探测，每隔1秒探测一回。
SIO_KEEPALIVE_VALS值Windows的OS独有的，Unix还是用SO_KEEPALIVE。

跑题远了，回到正题。如何监控Session呢，TDSSessionManager提供了方法给你插入监听事件。
上代码

var
  event: TDSSessionEvent;

initialization
  event := procedure(Sender: TObject;
            const EventType: TDSSessionEventType;
            const Session: TDSSession)
  begin
    case EventType of
      SessionCreate:
        begin
          LogInfo('SessionCreate');
          LogInfo(Format('SessionName=%s', [Session.SessionName]));
        end;
      SessionClose:
        begin
          LogInfo('SessionClose');
          LogInfo(Format('SessionName=%s', [Session.SessionName]));
        end;
    end;
  end;
  TDSSessionManager.Instance.AddSessionEvent(event);
finalization
  TDSSessionManager.Instance.RemoveSessionEvent(event);

这样就可以了，有多少事件都可以插入监听。

datasnap的初步 直接返会自定义类

前面我说datasnap不支持自定义类型是错误的。其实datasnap一旦发现是自定义类型，就会自动用json给marshall了，今天的测试代码如下。

服务器端

function TServerMethods1.GetPerson: TPerson;
begin
  Result := TPerson.Create;
  Result.FirstName := 'zyz';
  Result.LastName := 'Jacky';
  Result.Age := 21;
end;

客户端，让SQLConnection自动产生代理代码，可以的到

function TServerMethods1Client.GetPerson: TPerson;
begin
  if FGetPersonCommand = nil then
  begin
    FGetPersonCommand := FDBXConnection.CreateCommand;
    FGetPersonCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FGetPersonCommand.Text := 'TServerMethods1.GetPerson';
    FGetPersonCommand.Prepare;
  end;
  FGetPersonCommand.ExecuteUpdate;
  if not FGetPersonCommand.Parameters[0].Value.IsNull then
  begin
    FUnMarshal := TDBXClientCommand(FGetPersonCommand.Parameters[0].ConnectionHandler).GetJSONUnMarshaler;
    try
      Result := TPerson(FUnMarshal.UnMarshal(FGetPersonCommand.Parameters[0].Value.GetJSONValue(True)));
      if FInstanceOwner then
        FGetPersonCommand.FreeOnExecute(Result);
    finally
      FreeAndNil(FUnMarshal)
    end
  end
  else
    Result := nil;
end;

也就是说，客户端也会自动给unmarshal的。
调用代码

procedure TForm1.btn3Click(Sender: TObject);
var
  p: TPerson;
begin
  p := FServerMethod.GetPerson;
  with p do
  ShowMessage(Format('FirstName=%s, LastName=%s, Age=%d',
      [FirstName, LastName, Age]));
  //p.Free;
end;

由于我的FInstanceOwner使用的默认为true，UnMarshal的CreateObject产生的类，让Datasnap自己去释放了，所以p.free要注视掉。释放的时机有两个：
1。下一次调用到来
2。DBXCommand.Close

datasnap的初步 TDSTCPServerTransport的OnConnect

了解到indy的执行后，就能明确TDSTCPServerTransport的OnConnect的执行时机了。

 TDSTCPServerTransport的Start里，将OnConnect给了TIdTCPServerPeer的OnConnectEvent，
而 TIdTCPServerPeer的LOnConnectEvent关联着TIdTCPServer的OnConnect。LOnConnectEvent执行时，执行OnConnectEvent。
 所以 OnConnect是在TIdThreadWithTask的Execute的BeforeRun里被执行了。这时，线程TIdThreadWithTask已经建立，但啥也没做。而TIdThreadWithTask又是被TIdSchedulerOfThreadPool给缓存着的。在这个事件里面Disconnect来防止DDOS应该还是可取的。

datasnap的初步 重温Indy的TIdTCPServer的实现

Indy10其实真的挺强大了，跟着D2005出来都好多年了，更新很少，没前进其实就是后退，linux的epool在windows没有也就算了，IOCP的发展indy没跟上（SuperCore包的IOCP只支持D7），这的确有些说不过去吧。废话少说，还是复习一下Indy10的实现。

Indy自身就很复杂，只做一个最简单复习了。

1.
 TIdCustomTCPServer的StartListening启动，建立socket，bind，然后listen，然后建立TIdListenerThread线程，让TIdListenerThread来听。

2.TIdListenerThread的Run里
进来就
    LYarn := Server.Scheduler.AcquireYarn; 
这得到一TIdYarnOfThread的实例(创建了线程)，默认情况线程是TIdSchedulerOfThreadDefault的NewThread建立的，FreeOnTerminate为true，也就是说线程跑完就Free了。
 然后select(250) fd，如果有连接到来，就accept，用来存储accept结果的是TIdIOHandlerSocket类。然后开始建立TIdTCPConnection，它接管TIdIOHandlerSocket。建立TIdContext类(是TIdTask的子类)，根据TIdTCPConnection创建任务(Task)了，并将一些TIdCustomTCPServer的事件给TIdContext

    LContext := Server.FContextClass.Create(LPeer, LYarn, Server.Contexts);
    LContext.FServer := Server;
    LContext.OnBeforeRun := Server.ContextConnected;
    LContext.OnRun := Server.DoExecute;
    LContext.OnAfterRun := Server.ContextDisconnected;
    LContext.OnException := Server.DoException;

3. 先明确几个类
TIdTask，任务，也就是要做的事情的内容。
TIdYard，这个就是一个载体，啥也不是，可理解为TObject。
TIdThreadWithTask，这个是一个TThread的子类，它有一个TIdTask的属性。
TIdYarnOfThread，是TIdYarn的子类，有两个属性：TIdScheduler和 TIdThreadWithTask。
根据2的步骤，Thread和Task都有，那么就差执行了，于是让Scheduler来执行
    Server.Scheduler.StartYarn(LYarn, LContext); 在这里，新的线程就开始执行了。
执行的方式为TIdThreadWithTask的Run里调用Task的Run，而Task的Run，就是Server.DoExecute了。所以TIdTCPServer的好几个事件，是在TIdThreadWithTask线程里面运行的，如果要在这些事件里修改VCL的东西或者释放资源（最好是不要去修改VCL的东西），要特别留意同步问题，别和主线程死锁了(比如发消息用PostMessage而不要SendMessage)


4.至于为啥要让Scheduler来管理，这主要是为了扩展吧，比如线程池，EMBT自己提供的一个类叫TIdSchedulerOfThreadPool，这个类在DataSnap里面用到了。TDSTCPServerTransport的PoolSize和MaxThreads两个属性，就是给TIdSchedulerOfThreadPool用的。PoolSize，表示初始化是会建立PoolSize个TIdThreadWithTask线程放着备用，MaxThreads表示TIdSchedulerOfThread.NewThread能够New出来的最大线程数。


另外，我这里一直说线程线程，其实Indy的TIdYard的设计，主要还是为了不同平台的兼容(TIdYard这载体啥都能放啊)，Indy还支持Windows的纤程(Fibers)，只要将TIdTCPServer的Schedule设置为TIdSchedulerOfFiber即可。纤程这东西，比较复杂，理论上说比thread少耗资源，也能突破一进程2028个线程的限制，可控制要用户自己切题。再说了，真的要上大连接量的应用，谁也不会用Indy来找死。

最后，Indy的主站www.indyproject.org早不更新了，要下载最新代码请到indy.fulgan.com/ZIP/。据说Indy11正酝酿中，期待ing。

datasnap的初步 TDSTCPServerTransport的TCPServer

都知道TDSTCPServerTransport的后面默认其实是Indy来工作的，RO做通讯时，却可选择Indy,Synapse等，其实datasnap的设计者，也留下了口子给你扩展的。


TDSTCPServerTransport的Server其实和Indy无关，有关的是IIPTCPServer接口。也就是只要你实现了IIPTCPServer接口，就可以给TDSTCPServerTransport做Server。默认的IIPTCPServer接口的实现者是TIdTCPServerPeer，代码在IndyPeerImpl.pas里。
请看这一行

initialization 
  PeerFactory.RegisterPeer(IPImpId, IIPTCPServer, TIdTCPServerPeer);

这里就将IIPTCPServer 和 TIdTCPServerPeer关联起来了。TIdTCPServerPeer有一个TIdTCPServerIP的成员，而TIdTCPServerIP继承自TIdTCPServer。从而和Indy勾上了。

function TDSTCPServerTransport.CreateTcpServer: IIPTCPServer;
begin
  Result := PeerFactory.CreatePeer(IPImplementationID, IIPTCPServer, nil) as IIPTCPServer;
end;

这里创建IIPTCPServer时，其实PeerFactory根据RTTI，创建了一个TIdTCPServerPeer的实例。

留意一下 CreatePeer的第一个参数IPImplementationID，这个参数是TDSTCPServerTransport的属性，Help文档里啥也没解释，其实EMBT就是打算靠这个来给你做扩展的。缺省情况IPImplementationID为空，对应着了IndyPeerImpl.pas。

datasnap的初步 服务器端如何防止DDOS

前面说到DSServer的OnConnect是socket已经完全搭好client都调用connect的服务器方法了才触发的，如果我们到这里才来想起拒绝不合法的ip连接，已经挺晚了：socket已经连接好了，都已经创建线程开始通讯了。

怎么做才能在最开始的socket握手里，就让捣蛋鬼死在萌芽中呢。

要解决这个问题，当然得从TDSTCPServerTransport下手，因为ServerTransport才是真正负责通讯的，可以在它的OnConnect事件下手

procedure TServerContainer1.DSTCPServerTransport1Connect(
  Event: TDSTCPConnectEventObject);
var
  conn: TIdTCPConnection;
begin
  conn := Event.Connection as TIdTCPConnection;
  LogInfo('From ' + conn.Socket.Binding.PeerIP + '(' + IntToStr(conn.Socket.Binding.PeerPort) + ')');
end;

在这里，就能得到连接上来的IP了，在blacklist里的ip，就可以直接  conn.Disconnect。当然，由于indy的架构，线程也是已经创建了的，要真正解决DDOS，下回再重述一下Indy架构来看看如何下手。

datasnap的初步 获得客户端的信息

记得datasnap 2009时，要得到客户端信息，非官方的方法，要去搞什么DSConnectEventObject.ChannelInfo.Id，弄成　TIdTCPConnection。xe2就好得多了。
仍然是在DSServer的OnConnect 事件里，
DSConnectEventObject.ChannelInfo.ClientInfo就是客户端的信息。
能得到啥？ 看代码

TDBXClientInfo = record
    IpAddress: String;
    ClientPort: String;
    Protocol: String;
    AppName: String;
  end;

也就是能取得客户端ip，端口，连接协议，不过AppName这玩意儿一直是空的。

执行到 DSServer的OnConnect的事件里，其实socket已经完全连上了，client已经调用了server的connect方法了，在这个方法里触发的OnConnect。所以DSServer的OnConnect其实并不是真的socket的OnConnect。

datasnap的初步 返回自定义的类数组

虽然datasnap不能直接传递自定义类，但是Marshal一下就可以了。写了个测试代码，返回自定义的类的数组。

上代码。

unit uPerson;

interface

uses
  Data.DBXJSONReflect, Data.DBXJSON, System.SysUtils;

type
  TPerson = class
    FirstName: string;
    LastName: string;
    Age: Integer;
  end;
  TPersonArray = array of TPerson;

function JSONMarshal(persons: TPersonArray): TJSONArray;
function JSONUnMarshal(persons: TJSONArray): TPersonArray;

implementation

function JSONMarshal(persons: TPersonArray): TJSONArray;
var
  i: Integer;
  mar: TJSONMarshal;
  jsonPerson: TJSONObject;
begin
  Result := TJSONArray.Create;
  mar := TJSONMarshal.Create(TJSONConverter.Create);
  for i := Low(persons) to High(persons) do
  begin
    jsonPerson := mar.Marshal(persons[i]) as TJSONObject;
    Result.AddElement(jsonPerson);
  end;
  FreeAndNil(mar);
end;

function JSONUnMarshal(persons: TJSONArray): TPersonArray;
var
  i: Integer;
  unmar: TJSONUnMarshal;
  person: TPerson;
begin
  SetLength(Result, persons.Size);
  unmar := TJSONUnMarshal.Create;
  for i := 0 to persons.Size - 1 do
  begin
    person := unmar.Unmarshal(persons.Get(i)) as TPerson;
    Result[i] := person;
  end;
  FreeAndNil(unmar);
end;

end.

服务器端代码

function TServerMethods1.GetPersons: TJSONArray;
var
  i: Integer;
  persons: TPersonArray;
begin
  SetLength(persons, 3);
  for i := Low(persons) to High(persons) do
  begin
    persons[i] := TPerson.Create;
    with persons[i] do
    begin
      FirstName := 'zzz' + Chr(Ord('A') + Random(20));
      LastName := 'yyy' + Chr(Ord('a') + Random(20));
      Age := Random(80);
    end;
  end;
  Result := JSONMarshal(persons);
  for i := Low(persons) to High(persons) do
    persons[i].Free;
end;

客户端代码

procedure TForm1.btn1Click(Sender: TObject);
var
  persons: TPersonArray;
  i: Integer;
begin
  persons := JSONUnMarshal(FServerMethod.GetPersons);
  mmo1.Clear;
  for i := Low(persons) to High(persons) do
  with persons[i] do
  begin
    mmo1.Lines.Add(Format('FirstName=%s, LastName=%s, Age=%d',
      [FirstName, LastName, Age]));
    Free;
  end;
end;

datasnap的初步 关于TDSTCPServerTransport的Filters

TDSTCPServerTransport的Filter属性，可以对传递的数据进行加密，压缩，再修改等，有点注入的概念。默认情况下，Datasnap自带的ZLIB, PC1，RSA三个Filter。测试了一下，RSA只对KEY加密，PC1才对内容加密，ZLIB来做压缩，ZLIB压缩实在不咋的。并且，Filter的顺序，是依次执行的。我现在打算实现，服务器的一个Log功能，记录下来进入的数据，出去的数据，要求记录下来的数据是明文。
 TTransportFilter的ProcessInput，ProcessOutput光看名字比较费解，可以这么理解ProcessInput为编码，ProcessOutput可以理解为解码。

 首先给DSTCPServerTransport1的Fitlers都加上默认的3个Filter。
 上一个完整的代码

unit uLogFilter;

interface

uses
  SysUtils, DBXPlatform, DBXTransport;

type
  TLogHeadFilter = class(TTransportFilter)
  public
    constructor Create; override;
    destructor Destroy; override;
    function ProcessInput(const Data: TBytes): TBytes; override;
    function ProcessOutput(const Data: TBytes): TBytes; override; //do nothing
    function Id: UnicodeString; override;
  end;

  TLogTailFilter = class(TTransportFilter)
  public
    constructor Create; override;
    destructor Destroy; override;
    function ProcessInput(const Data: TBytes): TBytes; override; //do nothing
    function ProcessOutput(const Data: TBytes): TBytes; override;
    function Id: UnicodeString; override;
  end;

procedure AddLogFilter(Filters: TTransportFilterCollection);

implementation

uses
  CodeSiteLogging;

const
  LogFilterName_Tail = 'LogTail';
  LogFilterName_Head = 'LogHead';

procedure AddLogFilter(Filters: TTransportFilterCollection);
var
  fs: TDBXStringArray;
  i: Integer;
begin
  fs := Filters.FilterIdList;
  Filters.Clear;
  Filters.AddFilter(LogFilterName_Head);
  for i := Low(fs) to High(fs) do
  begin
    Filters.AddFilter(fs[i]);
  end;
  Filters.AddFilter(LogFilterName_Tail);
end;

constructor TLogTailFilter.Create;
begin
  inherited Create;
  //CodeSite.Send(csmBlue, 'TLogTailFilter.Create');
end;

destructor TLogTailFilter.Destroy;
begin
  //CodeSite.Send(csmBlue, 'TLogTailFilter.Destroy');
  inherited Destroy;
end;

function TLogTailFilter.ProcessInput(const Data: TBytes): TBytes;
begin
  Result := Data;
  CodeSite.Send(csmOrange, 'To Client: ' + IntToStr(Length(Data)));
end;

function TLogTailFilter.ProcessOutput(const Data: TBytes): TBytes;
begin
  Result := Data;
  CodeSite.Send(csmOrange, 'From Client: ' + IntToStr(Length(Data)),
    TEncoding.ASCII.GetString(Data));
end;

function TLogTailFilter.Id: UnicodeString;
begin
  Result := LogFilterName_Tail;
end;

{ TLogInputFilter }

constructor TLogHeadFilter.Create;
begin
  inherited;
  //CodeSite.Send(csmBlue, 'TLogHeadFilter.Create');
end;

destructor TLogHeadFilter.Destroy;
begin
  //CodeSite.Send(csmBlue, 'TLogHeadFilter.Destroy');
  inherited;
end;

function TLogHeadFilter.Id: UnicodeString;
begin
  Result := LogFilterName_Head;
end;

function TLogHeadFilter.ProcessInput(const Data: TBytes): TBytes;
begin
  Result := Data;
  CodeSite.Send(csmYellow, 'To Client: ' + IntToStr(Length(Data)),
    TEncoding.ASCII.GetString(Data));
end;

function TLogHeadFilter.ProcessOutput(const Data: TBytes): TBytes;
begin
  Result := Data;
  CodeSite.Send(csmYellow, 'From Client: ' + IntToStr(Length(Data)));
end;

initialization

TTransportFilterFactory.RegisterFilter(LogFilterName_Tail, TLogTailFilter);
TTransportFilterFactory.RegisterFilter(LogFilterName_Head, TLogHeadFilter);

finalization

TTransportFilterFactory.UnregisterFilter(LogFilterName_Tail);
TTransportFilterFactory.UnregisterFilter(LogFilterName_Head);

end.

这个unit实现了上面的功能，
数据进入服务器时，DataSnap的Reader读出时按顺序经过Filter进行解码，最后的Filter，也就是这里的TLogTailFilter的ProcessOutput出来的肯定应该是明文了，记录下来。
数据出服务器时， DataSnap的Writer写数据时，也按顺序经过Filter进行编码，刚开始的肯定是明文的，也就是TLogHeadFilter的ProcessInput了，记录下来。

要使用这个unit，只要在ServerContainerUnit1单一的OnCreate里面写入即可。如下

procedure TServerContainer1.DataModuleCreate(Sender: TObject);
begin
  AddLogFilter(DSTCPServerTransport1.Filters);
end; 

最后，上个图，看看client和服务器之间的通讯是怎样的。

为方面看，我分开了，第一次是connect，然后二次调用了EchoString。可以看出一次servermethod，有3个来回的交流(一个prepare, 一个execute，一个command_close。prepare和command_close并不是每次必须的，这里因为我是每次都创建新的TServerMethods1Client)，并且交流的数据都是JSON的整列。这里也打印出了编码解码前数据长度，以及编码解码后的数据长度，如果要测试ZLIB的压缩效果，可以参考。

或许要说DSServer的OnTrace事件也可以玩，但是 OnTrace只能记录Client进Server的数据，对出去的数据TRACE不到的，很遗憾。

最后，有一些其他的现成的开源Filter可用，尤其是压缩的，去http://code.google.com/p/dsfc/

datasnap的初步 内存泄漏的原因

终于找到了datasnap内存泄漏的原因了，只要你写了下面的代码，肯定出现内存泄漏，无论是session还是invocation。我表示很悲痛。

procedure TServerContainer1.DSServerClass1CreateInstance(
  DSCreateInstanceEventObject: TDSCreateInstanceEventObject);
begin
//
end;

procedure TServerContainer1.DSServerClass1DestroyInstance(
  DSDestroyInstanceEventObject: TDSDestroyInstanceEventObject);
begin
//
end;

 Help里面写道
 DSServer.TDSServerClass.OnCreateInstance

Happens upon creation of server class instances.
Use this event to override the default creation of server class instances. This allows for custom initialization and custom object pooling if the LifeCycle property is set to TDSLifeCycle.Invocation.

 是说只有在Invocation才使用这两个事件。可session模式下就算写了，也不应该内存泄漏吧。再说了，invocation模式下，这个函数啥也不干，还是是泄漏了。

datasnap的初步 实在很无语，update1之后，datasnap服务端内存泄漏多了好多

实在很无语，update1之后，datasnap服务端内存泄漏多了好多，只做很简单的一个返回数据集的事情，就能搞出很多内存泄漏出来，上图

好像，服务端，无聊是session还是invocation，根本就不去释放TServerMethod1(TDSServerModule)了，Embarcadero在搞什么机器。

datasnap的初步 对象的销毁

TServerMethods1Client继承自TDSAdminClient，这个类的构造函数

    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;

后面的AInstanceOwner参数，挺重要，理解这个，对于避免内存泄漏有很大好处。
 默 认情况下，我们使用Create来创建ServerMethodClient，也就AInstanceOwner为true了，也就是所有进入 TServerMethods1Client类方法的参数，都被ServerMethodClient给来释放。我觉得EMBT推荐使用 AInstanceOwner=True。

 DATASNP如何释放内存，请看代码
客户端

procedure TDBXCommand.CommandExecuting;
begin
  if Assigned(FFreeOnCloseList) then  
    FreeOnExecuteObjects;//这里释放
  Open;
  CloseReader;
  if (FParameters <> nil) and (FParameters.Count > 0) then
  begin
    if not FPrepared then
      Prepare;
    SetParameters;
  end;
end;

也就是说，对每个DBXCommand，每次执行前都会清理上一回留下的垃圾。当然最后的垃圾肯定要等到DBXCommand.Close时才去清理了。
对于function(a: TA, out b: TB): TA这样的调用
 AInstanceOwner为true时，a, b, 以及返回值result我们都不用去自己Free。尤其要注意入口参数a，可能进去执行后立刻被Free(需要被Marshal的类)，也可能是等到下次Call时被Free(比如TStream)。
 反之，则都需要自己去free。但是TDBXCallback，是个例外，就算AInstanceOwner为False，也不能自己Free。


服务器端

procedure TDSMethodValues.AssignParameterValues(
  Parameters: TDBXParameterArray);
begin
  ClearReferenceParameters; //这里清理
  if Length(FMethodValues) <> Length(Parameters) then
  begin
    SetLength(FMethodValues, Length(Parameters));
    SetLength(FAllocatedObjects, Length(Parameters));
  end;

也是一样的，每回清理前一回留下的垃圾，最后的也是客户端调用DBXCommand.Close时服务器收到"command_close"时被清理，当然服务器自己关闭DBXCommand时也会清理的。

从这个规则，也能看出，客户端，如果要多线程访问服务器，要么访问服务器时聚集到一起，用关键区或者信号量控制同时只有一个线程能上服务器，要么起多个连接。以避免A线程正读的欢呢，B线程就去Call同样的ServerMethod了，把返回结果给Free了。

最后读读EMBT的帖子吧

XE2 update1

今天装了一下xe2 update1，据说修改了120多个bug，没啥感觉。这update1推出也太快了，是好事也是坏事。感觉目前的embarcadero比以前borland在做生产线上要好不少，路线比较明晰，帮助文档也像模像样了，给人多少有个盼头，不过路仍然艰辛得很，除了老的vcl（老的vcl也过时），新的框架eco，dbx, datasnap等仍然没一个真的可圈可点。每回概念都很好，就是做不精，bug多让人泄气。牢骚，纯粹牢骚。

datasnap的初步 TDSAuthenticationManager的用法

xe开始有了TDSAuthenticationManager，这个主要用来做用户认证，用法也很简单

服务器端
1.TDSAuthenticationManager有两个主要的事件

在这个事件里面，看看检测连上来的用户名，密码是否合法，valid如果置为false，这就为非法连接了，DSServer会立刻抛出异常后close连接。
另外，UserRoles的设计，我觉得比RO高明。

procedure TServerContainer1.DSAuthenticationManager1UserAuthenticate(
  Sender: TObject; const Protocol, Context, User, Password: string;
  var valid: Boolean; UserRoles: TStrings);
begin
  valid := User = 'zyz';

  if User = 'admin' then
    UserRoles.Add('admins');
end;

在这个事件里面，判断已经连接上来的用户，对ServerMethod的调用是否合法，注视里也写了，默认是如何检测是否合法的。

procedure TServerContainer1.DSAuthenticationManager1UserAuthorize(
  Sender: TObject; EventObject: TDSAuthorizeEventObject;
  var valid: Boolean);
begin
  { TODO : Authorize a user to execute a method.
    Use values from EventObject such as UserName, UserRoles, AuthorizedRoles and DeniedRoles.
    Use DSAuthenticationManager1.Roles to define Authorized and Denied roles
    for particular server methods. }
  //valid := True;
end;

上面我说UserRoles的设计比较高明，主要还是因为这个UserRole的设计用到了java的那种注释类的技术，比如服务器上这么定义一个方法

    [TRoleAuth('admins')]
    function EchoString(Value: string): string;

这样定义后，就算不写DSAuthenticationManager1UserAuthorize，TDSAuthenticationManager也会自动帮你检查该角色是否有权利调用该ServerMethod。RTTI估计是学Java的Annotation才增加了TCustomAttribute。


 2.客户端
客户端很简单了，设置SQLConnection的DSAuthUser和DSAuthPassword就行了。

datasnap的初步 生命期LifeCycle

TDSServerClass有一个属性LifeCycle，这个属性有三个值，很好理解
1.Session，这是默认值。
就是一个连接，一个Session，一个Session的意思就是连接上来后，服务器端就创建一个DSServerClassGetClass里返回的PersistentClass一个实例，并一直保持到连接断开，所有这期间的ServerMethod调用，都是这个实例的调用。所以这是线程安全的。

2.Server
顾名思义，就是全局就一个PersistentClass的实例，所有的连接Call上来的ServerMethod都是这唯一实例的调用，单例模式，当然，这也就不是线程安全的，需要自己来实现线程安全。

3.Invocation
这个更细，每次ServerMethod的Call，都将创建和销毁一PersistentClass的实例。由于创建销毁比较耗资源，可以操作TDSServerClass的OnCreateInstance和OnDestroyInstance事件，在这两个事件里面做缓存池。代码如下

procedure TServerContainer1.DSServerClass1CreateInstance(
  DSCreateInstanceEventObject: TDSCreateInstanceEventObject);
begin
  DSCreateInstanceEventObject.ServerClassInstance := 缓存池取一个实例
end;

procedure TServerContainer1.DSServerClass1DestroyInstance(
  DSDestroyInstanceEventObject: TDSDestroyInstanceEventObject);
begin
  将DSCreateInstanceEventObject.ServerClassInstance的实例还给缓存池
end; 

缓存池的实现很简单了，就不写了。

datasnap的初步 序列化自己写的类

今天在网上找到了一个marshall和unmarshall的例子，将自己的定义的类，序列号json对象

uses DBXJSONReflect, DBXJSON

TPerson = class
    FirstName: String;
    LastName: String;
    Age: Integer;
end;

序列化

procedure TForm1.Button1Click(Sender: TObject);
var
  Mar: TJSONMarshal; //序列化对象
  UnMar: TJSONUnMarshal; // 反序列化对象
  person: TPerson; //我们自定义的对象
  SerializedPerson: TJSONObject; //Json对象
begin
  Mar := TJSONMarshal.Create(TJSONConverter.Create);
  try
    person := TPerson.Create;
    try
      person.FirstName := 'Nan';
      person.LastName := 'Dong';
      person.Age := 29;
      SerializedPerson := Mar.Marshal(person) as TJSONObject;
    finally
      FreeAndNil(person);
    end;
  finally
    Mar.Free;
  end;
  // show一下person的json对象的信息
  ShowMessage(SerializedPerson.ToString);
end;

反序列化
//UnMarshalling
  UnMar := TJSONUnMarshal.Create;
  try
    person := UnMar.UnMarshal(SerializedPerson) as TPerson;
    try
      // 我们用断言检查一下，unmarshal后的信息完全正确。
      Assert(person.FirstName = 'Nan');
      Assert(person.LastName = 'Dong');
      Assert(person.Age = 29);
    finally
      person.Free;
    end;
  finally
    UnMar.Free;
  end; 

datasnap的初步-回调函数

服务器端

 TServerMethods1 = class(TComponent)
  private
    { Private declarations }
  public
    { Public declarations }
    function Test(funcCallBack: TDBXCallback): boolean;
  end;

function TServerMethods1.Test(funcCallBack: TDBXCallback): boolean;
begin
  funcCallBack.Execute(TJSONNumber.Create(20)).Free;
  sleep(1000);
  Result := True;
end;

客户端，这个必须继承自TDBXCallback

 TFuncCallback = class(TDBXCallback)
    function Execute(const Arg: TJSONValue): TJSONValue; override;
  end;
function TFuncCallback .Execute(const Arg: TJSONValue): TJSONValue;
var
  i: Integer;
begin
  i := TJSONNumber(Arg).AsInt;//可以的到服务器回调来的参数
  Result := TJSONNull.Create;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  ClientModule1.ServerMethods1Client.Test(funcCallBack);
end;

initialization
  funcCallBack:= TFuncCallBack.Create;
finalization
  //FreeAndNil(funcCallBack); 

到此，实现了最基本的回叫。
D2010起提供了DSClientCallbackChannelManager这个控件，这是为了实现一次注册，多次回叫，使用方法很简单
1。客户端使用 DSClientCallbackChannelManager注册回叫函数

function RegisterCallback(const CallbackId: String; const Callback: TDBXCallback): boolean; overload; 

DSClientCallbackChannelManager控件带有一个ChannelName的属性，用于CallbackId分组用。ManagerId属性，可理解为ClientId，ClientId必须是唯一的，相同的ClientId，会被认为是相同地点来的连接。

不明白为啥 DSClientCallbackChannelManager要自己设置连接属性，而不是走TSQLConnection。

2。服务器端是TDSServer来做事，它有
两个函数

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里面所有的callbackid，
第二个是回调ChannelName里面指定的CallBackId
服务器上用GetAllChannelCallbackId能返回在某个ChannelName里面所有的CallbackId。

到此，我们就能使用DSClientCallbackChannelManager来制作一个简单的聊天软件，并能实现私聊的功能。但是如何处理，聊天用户掉线的问题，就比较麻烦了。

和RO比较，这设计有些像RO里的TROEventReceiver，但远没RO灵活， TROEventReceiver直接就能订阅(RegisterEventHandlers)上一堆服务器的事件，DataSnap却要定义一堆的TDBXCallback

datasnap的初步-服务器支持的参数类型

目前xe2仍然不支持自己定义的类，这和RO差别挺大。RO在服务器端和客户端分别RegisterROClass后，RO框架就能序列化和反序列化了。

网上找到的，一个文档说明目前支持的类型
http://blogs.embarcadero.com/jimtierney/2009/04/06/31461

可作为参数的类型
TDBXWideStringValue
TDBXAnsiStringValue
TDBXInt16Value
TDBXInt32Value
TDBXInt64Value
TDBXSingleValue
TDBXDoubleValue
TDBXBcdValue
TDBXTimeValue
TDBXDateValue
TDBXTimeStampValue
TDBXBooleanValue
TDBXReaderValue
TDBXStreamValue


可作为var和out的参数的类型

boolean
SmallInt
Integer
Int64
Single
Double
AnsiString
String
TDBXTime

TDataTime
TDBXDate

OleVariant

TStream
TDataSet
TParams
TDBXReader
TDBXConnection

datasnap的初步 手动更新数据集

datasnap的TDataSetProvider是强大，对于更新服务器端master表的单表更新等，不用写代码就能搞定，的确迅速，但如果表是联合查询出来的，或者服务器更新一条记录，将导致许多别的逻辑变化时，还是自己写更新语句来的可控。

自己写更新，除了最基本的定义结构定义接口的路子外，仍然可以使用TClientDataSet的Delta来提高生产力。在客户端将Delta作为参数，上传到服务器端，服务器来解析这个Delta，得到客户端的变化后自己做更新。

至于如何解析Delta，参考TDataSetProvider的源码就可得到TUpdateTree.DoUpdates做的事情。

偷懒的方法是服务器端仍然用TDataSetProvider来处理，直接调用TDataSetProvider的ApplyUpdate，然后处理TDataSetProvider的BeforeUpdateRecord事件，在这个事件里面拦截解析后的delta，操作数据库后，Applied设置为true。但这样做，事务的处理给 TDataSetProvider控制了，我觉得不是好的法子。

所以还是老实将上传上来的delta赋值给一个新的clientdataset的Data，然后while循环，模拟TUpdateTree.DoUpdates来自己做好。

datasnap的初步-返回数据集

现在的datasnap已经脱离了配布繁杂的COM，变成了基于json的datasnap了，那么以前的socksrv.exe不需要了，xe2的IDE里面的DataSnap Client下面的xxxConnection控件也不需要了，留着这些只是为了兼容以前的程序。

简单的写一个返回数据集的程序
一，服务端

TServerMethods1 = class(TDataModule)
    SQLConnection1: TSQLConnection;
    SQLDataSet1: TSQLDataSet;
  private
    { Private declarations }
  public
    { Public declarations }
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
    function GetEmployees: TDataSet;
  end;

在xe2里服务端写代码，{$METHODINFO ON/OFF}的编译指令不需要了。

function TServerMethods1.GetEmployees: TDataSet;
begin
  with SQLDataSet1 do
  begin
    CommandText := 'SELECT * FROM Employees';
    Open;
  end;
  Result := SQLDataSet1;
end;

这样就返回了一个数据集，DataSnap会在内部进行marshall和unmarshall，让客户端得到这个DataSet。

二，客户端
客户端更简单
一般配置为TClientDataSet-->TDataSetProvider-->TSqlServerMethod-->TSQLConnection

就能显示出来服务器上返回的数据集了，但这样返回的数据集，是不能直接调用ClientDataSet.ApplyUpdates来更新的。

要让DataSnap能自动更新，只能让服务器端用TDataSetProvider来export的方法数据客户端用TClientDataSet-->TDSProviderConnection-->TSQLConnection才行，但一般实际应用中，服务器的逻辑比较多的不仅仅是增加删除记录这么简单，比较少用DataSnap的自动更新。

delphi xe2

最近delphi xe2发布了，既然是能说成是delphi2以来最伟大的发布，抛开广告夸张的言辞，理应有不少炫人的新功能。

开一个博客，以用来摸索这新的delphi，做笔记，备忘。