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都能异步同步都玩转啊