2011年11月8日星期二

我正用的和用过的控件

目前用的
  1. jedi的jcl, jvcl,jedi开源的,但很多东西都过时了,消亡中。
  2. DevExpress做界面,收费的。
  3. FastReport做报表,收费的。
  4. ImageEn做画像相关的,3.12后免费了,挺好。速度不咋的,够用就行。
  5. UniDAC做数据连接,收费的
  6. BlackBox做安全,收费的。


用过很长时间的,决定少用或者不再用的
  1. Raize,一直用,但grid欠缺不少,现转向了DevExpress来做
  2. QuickReport,从D2就开始学的,功能太差了,早已过时的,但到D2007都还在用。
  3. TMS_Pack的,试过,感觉挺乱的,和Raize没法比。
  4. VCLSkin,用过一段时间,有几个bug,到5.6都没解决,放弃了。DevExpress自己也能换肤。
  5. RemoteObject,一直主要精力放在这上了,光RO还可以,但DA做的实在不咋的,关键还是收费的问题,决定彻底放弃,费了很多精力学的是彻底浪费了。现往datasnap上转。
  6. EnLib,用过,有两个程序还用了,但决定放弃, 因为DevExpress太出色了。

 其他的,只装了cnPack,去掉了Castalia。也去掉了mad,去掉了EurekaLog,因为jcldebug就挺好,简单还开源。

2011年11月2日星期三

转贴:要想代码快,注意事项

看到片文章,多线程时,要想快,注意一下这些地方:


Here are some (not dogmatic, just from experiment and knowledge of low-level Delphi RTL) advice if you want to write FAST multi-threaded application in Delphi:
  • Always use const for string or dynamic array parameters like in MyFunc(const aString: String) to avoid allocating a temporary string per each call;
  • Avoid using string concatenation (s := s+'Blabla'+IntToStr(i)) , but rely on a buffered writing such as TStringBuilder available in latest versions of Delphi;
  • TStringBuilder is not perfect either: for instance, it will create a lot of temporary strings for appending some numerical data, and will use the awfully slow SysUtils.IntToStr() function when you add some integer value - I had to rewrite a lot of low-level functions to avoid most string allocation in our TTextWriter class as defined in SynCommons.pas;
  • Don't abuse on critical sections, let them be as small as possible, but rely on some atomic modifiers if you need some concurrent access - see e.g. InterlockedIncrement / InterlockedExchangeAdd;
  • InterlockedExchange (from SysUtils.pas) is a good way of updating a buffer or a shared object. You create an updated version of of some content in your thread, then you exchange a shared pointer to the data (e.g. a TObject instance) in one low-level CPU operation. It will notify the change to the other threads, with very good multi-thread scaling. You'll have to take care of the data integrity, but it works very well in practice.
  • Don't share data between threads, but rather make your own private copy or rely on some read-only buffers (the RCU pattern is the better for scaling);
  • Don't use indexed access to string characters, but rely on some optimized functions like PosEx() for instance;
  • Don't mix AnsiString/UnicodeString kind of variables/functions, and check the generated asm code via Alt-F2 to track any hidden unwanted conversion (e.g. call UStrFromPCharLen);
  • Rather use var parameters in a procedure instead of function returning a string (a function returning a string will add an UStrAsg/LStrAsg call which has a LOCK which will flush all CPU cores);
  • If you can, for your data or text parsing, use pointers and some static stack-allocated buffers instead of temporary strings or dynamic arrays;
  • Don't create a TMemoryStream each time you need one, but rely on a private instance in your class, already sized in enough memory, in which you will write data using Position to retrieve the end of data and not changing its Size (which will be the memory block allocated by the MM);
  • Limit the number of class instances you create: try to reuse the same instance, and if you can, use some record/object pointers on already allocated memory buffers, mapping the data without copying it into temporary memory;
  • Always use test-driven development, with dedicated multi-threaded test, trying to reach the worse-case limit (increase number of threads, data content, add some incoherent data, pause at random, try to stress network or disk access, benchmark with timing on real data...);
  • Never trust your instinct, but use accurate timing on real data and process.

2011年11月1日星期二

TMonitor和TInterlocked

自D2009后TMonitor出现,估计是现在vcl里面用的最多的了,涉及到加锁解锁的地方到处都是。
用TMoitor的好处显而易见,比起SyncObjs单元定义的类(比如TCriticalSection),不用和os内核打交道就把事情办了,这也是向java看齐,和java的关键字synchronized 一样。为了实现TMonitor,Delphi的TObject.InstanceSize从4变成了8(除了VMT的4byte,附加了4byte),这样就让任何类都可以给TMonitor来使用。可以看这里

使用方法异常简单
var
  lock: TObject;
  lock:= TObject.Create;  //定义一加锁变量

begin
  try
    System.TMonitor.Enter(lock);
    ...
  finally
    System.TMonitor.Exit(lock);
  end;
end;
TMonitor的Wait和Pulse以及PulseAll,java的wait, notify, notifyall相当。


提到加锁,就能想到单例模式时常用的一段代码,比如
  TSingleton = class
  strict private
    class var FInstance: TSingleton;
  public
    class function Instance: TSingleton; 
  end;

{ TSingleton }

class function TSingleton.Instance: TSingleton;
begin
  if not Assigned(FInstance) then
    FInstance := TSingleton.Create;
  Result := FInstance;
end;
这段代码其实是有问题的,因为:
判断完是否为nil后,执行下一句之前,可能FInstance有改变。也就是说FInstance可能被赋值了,然后如果再去赋值一次,从而导致泄漏一个TSingleton的实例
要解决这个,1个是用上面的TMonitor给加锁,但是这样岂不是每次调用TSingleton.Instance时都得加锁解锁一回,与理不容。
另一个法子则是用SyncObjs新增的类(XE后加的),TInterlocked。
没这个类之前,要解决这个,又得和os内核打交道,用windows api的InterlockedExchange来完成(Delphi XE前的System.pas里的InterlockedCompareExchangePointer函数没公开出来的)。但是现在有了TInterlocked,就又可以不和os打交道就完成了
代码如下
class function TSingleton.Instance: TSingleton;
begin
  if FInstance = nil then
  begin
    Result := TSingleton.Create;
    if TInterlocked.CompareExchange(Pointer(FInstance), Pointer(Result), nil) <> nil then
      Result.Free;//CompareExchange会返回FInstance之前值,如果不是nil,表示已经被赋值过了,那么就free掉现在新建的实例。
  end;
  Result := FInstance;
end;
查看TInterlocked的代码,可以看到,EMBT没有使用windows api去实现的,而是用汇编,汇编俺早忘光了。
代码如下:
class function TInterlocked.CompareExchange(var Target: Pointer; Value: Pointer; Comparand: Pointer): Pointer;
{$IFDEF X64ASM}
asm
  .NOFRAME
  MOV  RAX,R8
  LOCK CMPXCHG [RCX],RDX
end;
{$ELSE !X64ASM}
{$IFDEF X86ASM}
asm
  XCHG EAX,EDX
  XCHG EAX,ECX
  LOCK CMPXCHG [EDX],ECX
end;
{$ENDIF X86ASM}
{$ENDIF !X64ASM}

和TMonitor类一样,也是靠汇编的LOCK前缀搞定的。
Intel这么解释LOCK
Causes the processor's LOCK# signal to be asserted during execution of the accompanying instruction (turns the instruction into an atomic instruction). In a multiprocessor environment, the LOCK# signal insures that the processor has exclusive use of any shared memory while the signal is asserted.
所以,用ASM的lock,其实并不是个很好的法子(当然和cpu直接比起和os api打交道,要好非常多的了),因为lock操作冻结了所有cpu的core,这在多core的cpu上几乎无法容忍,Synopse看到这个问题(比如delphi的string,interface的引用计算也是靠LOCK来整的),写了新的SynScaleMM内存管理器,提出了别的实现方法,开源的。但是话又说回来,现在的硬件这么快(今天测试玩HP DL580 G7 Intel Xeon E7-4870,tmd 4个4870cpu,那个快啊),lock就lock呗,FastMM已经工作得非常棒了。

最后,TMonitor的设计和实现是Allen Bauer做的,用得爽没事去溜达他的blog吧。另外要提一下TMonitor是个record,不是class哦,下次再谈谈为啥。

datasnap的进阶 REST时的再说回调函数

XE2提供了一个ChatRoomDemo的例子,REST形式的。要实现这个功能,客户端js调用服务器端的代码,实现聊天者的相互沟通。
服务端的代码
function TChatRoomServerMethods.SendMessage(const Msg: String): Boolean;
var
  MesgTrimmed: String;
  Session: TDSSession;
  JSONMsg: TJSONObject;
begin
  MesgTrimmed := Trim(Msg);

  //no message to send, so just exit
  if Msg = EmptyStr then
    Exit(false);

  //get the current session
  Session := TDSSessionManager.GetThreadSession;

  //if the session is invalid, don't send a message
  if (Session = nil) or (not TChatRoomUsers.Instance.UserExists(Session.UserName)) then
    Exit(false);

  //wrap the message in a JSON object
  JSONMsg := TJSONObject.Create;
  JSONMsg.AddPair(TJSONPair.Create('notificationType', 'message'));
  JSONMsg.AddPair(TJSONPair.Create('from', Session.UserName));
  JSONMsg.AddPair(TJSONPair.Create('message', GetHTMLEscapedString(MesgTrimmed)));

  //Send the message to all logged in users
  Result := ServerContainerForm.ChatRoomServer.BroadcastMessage(CHAT_ROOM_ID, JSONMsg);
end;

function TChatRoomServerMethods.SendMessageToUser(const Msg, UserName: String): Boolean;
var
  MesgTrimmed: String;
  Session: TDSSession;
  JSONMsg: TJSONObject;
  Resp: TJSONValue;
begin
  MesgTrimmed := Trim(Msg);

  //no message to send, so just exit
  if Msg = EmptyStr then
    Exit(false);

  //no user to send message to
  if not TChatRoomUsers.Instance.UserExists(UserName) then
    Exit(false);

  //get the current session
  Session := TDSSessionManager.GetThreadSession;

  //if the session is invalid, don't send a message
  if (Session = nil) or (not TChatRoomUsers.Instance.UserExists(Session.UserName)) then
    Exit(false);

  //don't message yourself!
  if AnsiCompareText(Session.UserName, UserName) = 0 then
    Exit(false);

  //wrap the message in a JSON object
  JSONMsg := TJSONObject.Create;
  JSONMsg.AddPair(TJSONPair.Create('notificationType', 'privatemessage'));
  JSONMsg.AddPair(TJSONPair.Create('from', Session.UserName));
  JSONMsg.AddPair(TJSONPair.Create('message', GetHTMLEscapedString(MesgTrimmed)));

  //Send the message to all logged in users
  Result := ServerContainerForm.ChatRoomServer.NotifyCallback(UserName, UserName, JSONMsg, Resp);

  //we don't care about the response message from the other client, only if it was successfully sent
  FreeAndNil(Resp);
end;
这里用到了两个函数,DSServer.BroadcastMessage和DSServer.NotifyCallback。现在要关心的是,这两个函数如何将数据,推送到了客户端的。

js客户端是通过startChannel()函数里面,建立了一个ClientChannel和一个ClientCallback,然后ClientChannel.connect(ClientCallback)的里面,建立了一个 CallbackLoop,这个CallbackLoop就是通过XMLHTTPRequest搭上去的常链接了。
查看客户端的CallbackFramework.js代码,可以看到CallbackLoop的start函数
  /*
   * Starts the loop, registering the client callback on the server and the initial client callback specified
   * @param firstCallback the first callback to register, as you can't register a client with the server without specifying the first callback
   */
  this.start = function(firstCallback) {
    if (this.stopped && (!nullOrEmptyStr(this.clientChannel) || firstCallback.serverChannelNames.length > 0))
    {
      this.stopped = false;
    
      //passes empty string for the ConsumeClientChannel last parameter, since this is initiating the channel, and has no value
      //passes true after the callback to say a response from the server is expected
      this.executor.executeMethod("ConsumeClientChannel", "GET", 
                             [this.clientChannel.serverChannelName, this.clientChannel.channelId, 
                              firstCallback.callbackId, arrayToCSV(firstCallback.serverChannelNames), this.securityToken, ""],
                              this.callback, true);

      if (isReferenceAFunction(this.clientChannel.onChannelStateChange)) {
        this.clientChannel.onChannelStateChange(new ClientChannelEventItem(this.clientChannel.EVENT_CHANNEL_START,
                                                                           this.clientChannel, firstCallback));
      }
    }
  };

服务器上的代码执行Datasnap.DSPlatform单元的
function TDBXServerComponent.ConsumeClientChannel(const ChannelName, ClientManagerId,
  CallbackId, ChannelNames, SecurityToken: String; ResponseData: TJSONValue): TJSONValue;
begin
  Result := ConsumeClientChannelTimeout(ChannelName, ClientManagerId, CallbackId, ChannelNames,
                                        SecurityToken, -1, ResponseData);
end;
需要留意的是,js的executeMethod函数的this.callback参数。
    /*
   * This function executes the given method with the specified parameters and then
   * notifies the callback when a response is received.
   * @param url the url to invoke
   * @param contentParam the parameter to pass through the content of the request (or null)
   * @param requestType must be one of: GET, POST, PUT, DELETE
   * @param callback An optioanl function with three parameters, the response object, the request's status (IE: 200) and the specified 'owner'
   *                 The object will be an array, which can contain string, numeric, JSON array or JSON object types.
   * @param hasResult true if a result from the server call is expected, false to ignore any result returned.
   *                  This is an optional parameter and defaults to 'true'
   * @param accept The string value to set for the Accept header of the HTTP request, or null to set as application/json
   * @return if callback in null then this function will return the result that would have 
   *         otherwise been passed to the callback
   */
  this.executeMethodURL = function(url, contentParam, requestType, callback, hasResult, accept) {
    if (hasResult == null)
    {
      hasResult = true;
    }
    
    requestType = validateRequestType(requestType);

    var request = getXmlHttpObject();  //得到XMLHTTPRequest对象

    //async is only true if there is a callback that can be notified on completion
    var useCallback = (callback != null);
    request.open(requestType, url, useCallback);

    if (useCallback)
    {
      request.onreadystatechange = function() {  //注册回调
        if (request.readyState == 4)
        {
          //the callback will be notified the execution finished even if there is no expected result
          JSONResult = hasResult ? parseHTTPResponse(request) : null;
          callback(JSONResult, request.status, owner);  //执行回调,也就是executeMethod函数的this.callback了。
        }
      };
    }

    if(contentParam != null)
    {
      contentParam = JSON.stringify(contentParam);
    }

    request.setRequestHeader("Accept", (accept == null ? "application/json" : accept));
    request.setRequestHeader("Content-Type", "text/plain;charset=UTF-8");
    request.setRequestHeader("If-Modified-Since", "Mon, 1 Oct 1990 05:00:00 GMT");
    
    var sessId = getSessionID();
    if(sessId != null)
    {
      request.setRequestHeader("Pragma", "dssession=" + sessId);
    }
    if (this.authentication != null)
    {
      request.setRequestHeader("Authorization", "Basic " + this.authentication);
    }
    request.send(contentParam);  //发送请求

    //if a callback wasn't used then simply return the result.
    //otherwise, return nothing because this function will finish executing before
    //the server call returns, so the result text will be empty until it is passed to the callback
    if (hasResult && !useCallback)
    {
      return parseHTTPResponse(request);
    }
  };
到这里,还没找到常链接,XMLHTTPRequest对象发送了请求,取得了结果,就退出了。这常链接在哪实现的??
继续看CallbackLoop.callback的代码
  /*
   * The callback which will handle a value passed in from the server and then pass
   * back a response to the server as long as the channel is active.
   */
  this.callback = function(responseObject, requestStatus, callbackLoop) {
    if (callbackLoop != null && !callbackLoop.stopped && responseObject != null)
    {
      //resolve the true response object
      responseObject = (responseObject.result != null) ? responseObject.result : responseObject;
      responseObject = isArray(responseObject) ? responseObject[0] : responseObject;
      
      //if the session this callback was created on has sense expired then stop the callback loop,
      //preventing any calls to callbackLoop.sendResponse from executing
      var sessId = getSessionID();
      if (sessId == null)
      {
        callbackLoop.stopped = true;
      }
      
      //session expired, so notify local callbacks and then stop the loop
      if (responseObject.SessionExpired != null)
      {
        callbackLoop.stopped = true; 
        for(var i = 0; i < clientChannel.callbacks.length; i++)
        {
          clientChannel.callbacks[i].notifyCallback(responseObject);
        }
        //notify that the channel has been closed
        if (isReferenceAFunction(clientChannel.onChannelStateChange)) {
          clientChannel.onChannelStateChange(new ClientChannelEventItem(clientChannel.EVENT_SERVER_DISCONNECT,
                                                                        clientChannel, null));
        }
      }
      //broadcast to all of the callbacks listening on the given channel
      else if (responseObject.broadcast != null) //广播
      {
        var paramArray = responseObject.broadcast;
        var paramValue = paramArray[0];
 
        //used to determine if the paramValue is (on the server) a JSONValue or a TObject
        var dataType = paramArray[1];

        var broadcastChannel = responseObject.channel == null ? clientChannel.serverChannelName : responseObject.channel;
        var doForAll = clientChannel.serverChannelName == broadcastChannel;

        for(var i = 0; i < clientChannel.callbacks.length; i++)
        {
          var currentCallback = clientChannel.callbacks[i];

          //Broadcast to the callback if the channel being broadcast to is the one specified in the ClientChannel,
          //or if it appears in the array of channels this specific callback cares about.
          if (doForAll || arrayIndexOf(currentCallback.serverChannelNames, broadcastChannel) > -1) {
            currentCallback.notifyCallback(paramValue, dataType);
          }
        }
        callbackLoop.sendResponse(true, callbackLoop);
      }
      //Invoke the specified callback
      else if (responseObject.invoke != null)  //触发特别的callback
      {
        var paramArray = responseObject.invoke;
        var callbackKey = paramArray[0];
        var paramValue = paramArray[1];
 
        //used to determine if the paramValue is (on the server) a JSONValue or a TObject
        var dataType = paramArray[2];

        var currCallback;
        for(var i = 0; i < clientChannel.callbacks.length; i++)
        {
          currCallback = clientChannel.callbacks[i];
 
          if (currCallback.callbackId == callbackKey)
          {
            callbackLoop.sendResponse(currCallback.notifyCallback(paramValue, dataType), callbackLoop);
            break;
          }
        }
      }
      //if an error has occured notify the callbacks and stop the loop
      else if (responseObject.error != null)
      {
        callbackLoop.stopped = true;
        for(var i = 0; i < clientChannel.callbacks.length; i++)
        {
          clientChannel.callbacks[i].notifyCallback(responseObject, "error");
        }
        //notify that the channel has been closed by
        if (isReferenceAFunction(clientChannel.onChannelStateChange)) {
          clientChannel.onChannelStateChange(new ClientChannelEventItem(this.clientChannel.EVENT_SERVER_DISCONNECT,
                                                                             this.clientChannel, null));
        }
      }
      //If the result key is 'close' or 'closeChannel' then no response should be sent, which means
      //the recursion of this loop will end. Otherwise, send a response to the server with
      //a value of false so the loop will continue and the server will know the invocation failed
      else if (responseObject.closeChannel == null && responseObject.close == null)
      {
        callbackLoop.sendResponse(false, callbackLoop);  //这里了,只要channel不关,就又再次送出Request,如此往复循环,也就成了callback Loop了。sendResponse同样是call DSAmin.ConsumeClientChannel用的是POST,而不是GET了。
      }
      else
      {
        callbackLoop.stopped = true;
        
        //notify each callback that it has been closed
        for(var i = 0; i < clientChannel.callbacks.length; i++)
        {
          clientChannel.callbacks[i].notifyCallback(responseObject, "closed");
        }
        
        //notify that the channel has been closed
        if (isReferenceAFunction(clientChannel.onChannelStateChange)) {
          clientChannel.onChannelStateChange(new ClientChannelEventItem(clientChannel.EVENT_CHANNEL_STOP,
                                                                        clientChannel, null));
        }
      }
    }
    else
    {
      if (callbackLoop != null) {
        if (!callbackLoop.stopped && isReferenceAFunction(clientChannel.onChannelStateChange)) {
          //notify that the channel has been closed by the server
          clientChannel.onChannelStateChange(new ClientChannelEventItem(clientChannel.EVENT_SERVER_DISCONNECT,
                                                                        clientChannel, null));
        }
        callbackLoop.stopped = true;
      }
    }
  };

也就是说,服务器往客户端推送信息,其实是靠js客户端不断的轮询实现的,这也是没法子的事情,基于HTTP的无状态链接,也只有这么做。另外,所谓的常链接,其实不是只有一个链接,因为每次轮询,都是新起一个XMLHttpRequest发出的请求的。
在ChatRoom的例子中,上面的notifyCallback,call的是下面的代码ClientCallback的第三个回调参数
  //create the messaging callback, to handle messages from the server and from other clients
  var callback = new ClientCallback(channel, userName, function(jsonValue, dataType) {
    if (jsonValue != null)
    {
      if (dataType == "closed")
      {
        addMessage(null, "You have been disconnected from the server. Sorry!", null, true);
      }
      else if (jsonValue.notificationType != null)
      {
        var type = jsonValue.notificationType;
      
        //the list of users has changed, so update it on the page
        if (type == "user_login" || type == "user_logout")
        {
          loadUsers();
        }
        //you received a public or private message, so add it to the message area
        else if (type == "message" || type == "privatemessage")
        {
          var isPrivate = type == "privatemessage";
          var from = jsonValue.from;
          var message = jsonValue.message;
 
          addMessage(from, message, isPrivate);
        }
      }
      //your session has expired!
      else if(jsonValue.SessionExpired != null)
      {
        addMessage(null, jsonValue.SessionExpired, null, true);

        //NOTE: you don't need to call stopChannel here, because the session has expired and therefore
        //this is the last message you will receive before the tunnel closes.
      }
    }
    return true;
  });
到这里,我们就能拿到前面的TDSServer.NotifyCallback和TDSServer.BroadcastMessage里面的const Msg: TJSONValue参数了,然后做自己的事情。

delphi的一些语法2

delphi有支持类中类,和java一样的。
  TA = class
  strict private
    spv: Integer;
  protected
    pv: Integer;

    type //开始定义类中类
    TIAproc = reference to procedure;
    TIA = class  //类中类
    strict private
      ispv: Integer;
    public
     class procedure ipA; virtual;
    end;

    procedure pB;

    type //又开始定义类中类了
    TIB = class(TA.TIA)
    public
      class procedure ipA; override;
    end;

  public
    procedure pA;
  end;
{ TA.TIB }

class procedure TA.TIB.ipA;
begin
  inherited;
  showmessage('TA.TIB.ipA');
end;

{ TA.TIA }

class procedure TA.TIA.ipA;
begin
  showmessage('TA.TIA.ipA');
end;

{ TA }

procedure TA.pA;
begin

end;

procedure TA.pB;
begin

end;
从上面,也可以看出class function是可以继承的,所以就算类函数,其实是有self参数。要想彻底和java的类函数一样,得给类函数加上static关键字。

Delphi7后有不少新语法,写语法blog有点土,直接看吧

2011年10月31日星期一

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的外衣,然后自己当客户端调用了服务罢了

2011年10月27日星期四

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/

2011年10月26日星期三

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;
怎么转换,和上面的一样的了。我是觉得这个方法比上面的法子好。

2011年10月25日星期二

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的具体实现思路我还没弄清楚,它是如何转发的还待看代码。

2011年10月22日星期六

匿名方法转换为对象方法

前面说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;

2011年10月21日星期五

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

2011年10月20日星期四

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; 

2011年10月18日星期二

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即可。


2011年10月17日星期一

函数引用的内存泄漏

今天发现一个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更容易死锁。

2011年10月15日星期六

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


2011年10月14日星期五

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。



2011年10月12日星期三

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/

2011年10月11日星期二

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模式下,这个函数啥也不干,还是是泄漏了。

2011年10月8日星期六

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多让人泄气。牢骚,纯粹牢骚。

2011年10月3日星期一

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









2011年10月1日星期六

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,做笔记,备忘。