Delphi的Structure View的小技巧

老久的问题了，但我一直没去追问。IDE的Structure View的小窗口，展开和收缩的功能，居然没在右键菜单里，我也一直以为没这功能。今天碰巧知道了，记录。

按小键盘的
/  可以全部折叠
*  可以全部展开
+  可以展开一层
-  可以收缩一层


Structure View的小窗口，很多毛病的，一切换再切回来，原来选择的地方，就没了，这点很要命，又得找半天。还好，这个窗口支持输入即使查询，可以跳到想要的类上，比如要找TAppender类，直接输入TA，选择就会移动到TA打头的类上。

重新编译DevExpress VCL 2.3

每次重新编译DevExpress都挺烦，拿到2.3后，写了个bat文件来编译。以后编译就简单了。

2.3仍然不支持x64，虽然官方说支持，但是我用dcc64.exe没编译过去。

DevExpress 的dpk文件里，直接OFF掉了REFERENCEINFO，也就是$Y-，所以不管怎么设置dcc32.exe的编译选项，编译出来的都是不能ctrl+click找到源码。我又不想将Sources路径添加到Lib Path，没法子只有全替换.dpk里的编译选项了，这样就算Sources路径在Browsing Path里，也能Ctrl+Click找到源码了。

我正用的和用过的控件

目前用的

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就挺好，简单还开源。

转贴：要想代码快，注意事项

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


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.

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有点土，直接看吧。