提醒：一次操作完成后，记得把设置同步里的条目取消，以免哪次不小心执行同步了而造成地址簿的误操作

 sInt sIntSon = {0};
 sIntSon.cSingle1 = 0x01;
 sIntSon.cSingle2 = 0x02;
 sIntSon.cSingle3 = 0x03;
 sIntSon.cSingle4 = 0x04;

 memcpy(&iNum,&sIntSon,sizeof(sIntSon));
 
 printf("\n output int 's four char number\n");
 printf("\n first = 0x%x, second = 0x%x , third = 0x%x , forth = 0x%x , iNum = 0x%x\n",
  sIntSon.cSingle1,sIntSon.cSingle2,sIntSon.cSingle3,sIntSon.cSingle4,iNum); 
 }

运行结果：

 output int 's four char number

 first = 0x1, second = 0x2 , third = 0x3 , forth = 0x4 , iNum = 0x4030201
Press any key to continue

分析：

1。结构体中子节是升序存放，经过内存拷贝后，int 中四个字节升序，刚好验证 Little endian 方式

    一：select模型
    二：WSAAsyncSelect模型
    三：WSAEventSelect模型
    四：Overlapped I/O 事件通知模型
    五：Overlapped I/O 完成例程模型
    六：IOCP模型

    老陈有一个在外地工作的女儿，不能经常回来，老陈和她通过信件联系。他们的信会被邮递员投递到他们的信箱里。
    这和Socket模型非常类似。下面我就以老陈接收信件为例讲解Socket I/O模型~~~

一：select模型

老陈非常想看到女儿的信。以至于他每隔10分钟就下楼检查信箱，看是否有女儿的信~~~~~
在这种情况下，“下楼检查信箱”然后回到楼上耽误了老陈太多的时间，以至于老陈无法做其他工作。
select模型和老陈的这种情况非常相似：周而复始地去检查......如果有数据......接收/发送.......

使用线程来select应该是通用的做法：
procedure TListenThread.Execute;
var
  addr     : TSockAddrIn;
  fd_read  : TFDSet;
  timeout  : TTimeVal;
  ASock,
  MainSock : TSocket;
  len, i   : Integer;
begin
  MainSock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
  addr.sin_family := AF_INET;
  addr.sin_port := htons(5678);
  addr.sin_addr.S_addr := htonl(INADDR_ANY);
  bind( MainSock, @addr, sizeof(addr) );
  listen( MainSock, 5 );

  while (not Terminated) do
  begin
    FD_ZERO( fd_read );
    FD_SET( MainSock, fd_read );
    timeout.tv_sec  := 0;
    timeout.tv_usec := 500;
    if select( 0, @fd_read, nil, nil, @timeout ) > 0 then //至少有1个等待Accept的connection
    begin
      if FD_ISSET( MainSock, fd_read ) then
      begin
        for i:=0 to fd_read.fd_count-1 do //注意，fd_count <= 64，也就是说select只能同时管理最多64个连接
        begin
          len := sizeof(addr);
          ASock := accept( MainSock, addr, len );
          if ASock <> INVALID_SOCKET then
             ....//为ASock创建一个新的线程，在新的线程中再不停地select
        end;
      end;
    end;
  end; //while (not self.Terminated)

  shutdown( MainSock, SD_BOTH );
  closesocket( MainSock );
end;

二：WSAAsyncSelect模型

后来，老陈使用了微软公司的新式信箱。这种信箱非常先进，一旦信箱里有新的信件，盖茨就会给老陈打电话：喂，大爷，你有新的信件了！从此，老陈再也不必频繁上下楼检查信箱了，牙也不疼了，你瞅准了，蓝天......不是，微软~~~~~~~~
微软提供的WSAAsyncSelect模型就是这个意思。

WSAAsyncSelect模型是Windows下最简单易用的一种Socket I/O模型。使用这种模型时，Windows会把网络事件以消息的形势通知应用程序。
首先定义一个消息标示常量：
const WM_SOCKET = WM_USER + 55;
再在主Form的private域添加一个处理此消息的函数声明：
private
  procedure WMSocket(var Msg: TMessage); message WM_SOCKET;
然后就可以使用WSAAsyncSelect了：
var
  addr  : TSockAddr;
  sock  : TSocket;

  sock := socket( AF_INET, SOCK_STREAM, IPPROTO_TCP );
  addr.sin_family := AF_INET;
  addr.sin_port := htons(5678);
  addr.sin_addr.S_addr := htonl(INADDR_ANY);
  bind( m_sock, @addr, sizeof(SOCKADDR) );

  WSAAsyncSelect( m_sock, Handle, WM_SOCKET, FD_ACCEPT or FD_CLOSE );

  listen( m_sock, 5 );
  ....

应用程序可以对收到WM_SOCKET消息进行分析，判断是哪一个socket产生了网络事件以及事件类型：

procedure TfmMain.WMSocket(var Msg: TMessage);
var
  sock    : TSocket;
  addr    : TSockAddrIn;
  addrlen : Integer;
  buf     : Array [0..4095] of Char;
begin
  //Msg的WParam是产生了网络事件的socket句柄，LParam则包含了事件类型
  case WSAGetSelectEvent( Msg.LParam ) of
    FD_ACCEPT :
    begin
      addrlen := sizeof(addr);
      sock := accept( Msg.WParam, addr, addrlen );
      if sock <> INVALID_SOCKET then
         WSAAsyncSelect( sock, Handle, WM_SOCKET, FD_READ or FD_WRITE or FD_CLOSE );
    end;

    FD_CLOSE : closesocket( Msg.WParam );
    FD_READ  : recv( Msg.WParam, buf[0], 4096, 0 );
    FD_WRITE : ;
  end; 
end;

三：WSAEventSelect模型

后来，微软的信箱非常畅销，购买微软信箱的人以百万计数......以至于盖茨每天24小时给客户打电话，累得腰酸背痛，喝蚁力神都不好使~~~~~~
微软改进了他们的信箱：在客户的家中添加一个附加装置，这个装置会监视客户的信箱，每当新的信件来临，此装置会发出“新信件到达”声，提醒老陈去收信。盖茨终于可以睡觉了。

同样要使用线程：
procedure TListenThread.Execute;
var
  hEvent : WSAEvent;
  ret    : Integer;
  ne     : TWSANetworkEvents;
  sock   : TSocket;
  adr    : TSockAddrIn;
  sMsg   : String;
  Index,
  EventTotal : DWORD;
  EventArray : Array [0..WSA_MAXIMUM_WAIT_EVENTS-1] of WSAEVENT;
begin
  ...socket...bind...
  hEvent := WSACreateEvent();
  WSAEventSelect( ListenSock, hEvent, FD_ACCEPT or FD_CLOSE );
  ...listen...

  while ( not Terminated ) do
  begin
    Index := WSAWaitForMultipleEvents( EventTotal, @EventArray[0], FALSE, WSA_INFINITE, FALSE );
    FillChar( ne, sizeof(ne), 0 );
    WSAEnumNetworkEvents( SockArray[Index-WSA_WAIT_EVENT_0],  EventArray[Index-WSA_WAIT_EVENT_0], @ne );

    if ( ne.lNetworkEvents and FD_ACCEPT ) > 0 then
    begin
      if ne.iErrorCode[FD_ACCEPT_BIT] <> 0 then
         continue;

      ret := sizeof(adr);
      sock := accept( SockArray[Index-WSA_WAIT_EVENT_0], adr, ret );
      if EventTotal > WSA_MAXIMUM_WAIT_EVENTS-1 then//这里WSA_MAXIMUM_WAIT_EVENTS同样是64
      begin
        closesocket( sock );
        continue;
      end;

      hEvent := WSACreateEvent();
      WSAEventSelect( sock, hEvent, FD_READ or FD_WRITE or FD_CLOSE );
      SockArray[EventTotal] := sock;
      EventArray[EventTotal] := hEvent;
      Inc( EventTotal );
    end;

    if ( ne.lNetworkEvents and FD_READ ) > 0 then
    begin
      if ne.iErrorCode[FD_READ_BIT] <> 0 then
         continue;
      FillChar( RecvBuf[0], PACK_SIZE_RECEIVE, 0 );
      ret := recv( SockArray[Index-WSA_WAIT_EVENT_0], RecvBuf[0], PACK_SIZE_RECEIVE, 0 );
      ......
    end;
  end;
end;

四：Overlapped I/O 事件通知模型

后来，微软通过调查发现，老陈不喜欢上下楼收发信件，因为上下楼其实很浪费时间。于是微软再次改进他们的信箱。新式的信箱采用了更为先进的技术，只要用户告诉微软自己的家在几楼几号，新式信箱会把信件直接传送到用户的家中，然后告诉用户，你的信件已经放到你的家中了！老陈很高兴，因为他不必再亲自收发信件了！

Overlapped I/O 事件通知模型和WSAEventSelect模型在实现上非常相似，主要区别在“Overlapped”，Overlapped模型是让应用程序使用重叠数据结构(WSAOVERLAPPED)，一次投递一个或多个Winsock I/O请求。这些提交的请求完成后，应用程序会收到通知。什么意思呢？就是说，如果你想从socket上接收数据，只需要告诉系统，由系统为你接收数据，而你需要做的只是为系统提供一个缓冲区~~~~~
Listen线程和WSAEventSelect模型一模一样，Recv/Send线程则完全不同：
procedure TOverlapThread.Execute;
var
  dwTemp : DWORD;
  ret    : Integer;
  Index  : DWORD;
begin
  ......

  while ( not Terminated ) do
  begin
    Index := WSAWaitForMultipleEvents( FLinks.Count, @FLinks.Events[0], FALSE, RECV_TIME_OUT, FALSE );
    Dec( Index, WSA_WAIT_EVENT_0 );
    if Index > WSA_MAXIMUM_WAIT_EVENTS-1 then //超时或者其他错误
       continue;

    WSAResetEvent( FLinks.Events[Index] );
    WSAGetOverlappedResult( FLinks.Sockets[Index], FLinks.pOverlaps[Index], @dwTemp, FALSE, FLinks.pdwFlags[Index]^ );

    if dwTemp = 0 then //连接已经关闭
    begin
      ......
      continue;
    end else
    begin
      fmMain.ListBox1.Items.Add( FLinks.pBufs[Index]^.buf );
    end;

    //初始化缓冲区
    FLinks.pdwFlags[Index]^ := 0;
    FillChar( FLinks.pOverlaps[Index]^, sizeof(WSAOVERLAPPED), 0 );
    FLinks.pOverlaps[Index]^.hEvent := FLinks.Events[Index];
    FillChar( FLinks.pBufs[Index]^.buf^, BUFFER_SIZE, 0 );

    //递一个接收数据请求
    WSARecv( FLinks.Sockets[Index], FLinks.pBufs[Index], 1, FLinks.pdwRecvd[Index]^, FLinks.pdwFlags[Index]^, FLinks.pOverlaps[Index], nil );
  end;
end;

五：Overlapped I/O 完成例程模型

老陈接收到新的信件后，一般的程序是：打开信封----掏出信纸----阅读信件----回复信件......为了进一步减轻用户负担，微软又开发了一种新的技术：用户只要告诉微软对信件的操作步骤，微软信箱将按照这些步骤去处理信件，不再需要用户亲自拆信/阅读/回复了！老陈终于过上了小资生活！

Overlapped I/O 完成例程要求用户提供一个回调函数，发生新的网络事件的时候系统将执行这个函数：
procedure WorkerRoutine( const dwError, cbTransferred : DWORD; const
          lpOverlapped : LPWSAOVERLAPPED; const dwFlags : DWORD ); stdcall;
然后告诉系统用WorkerRoutine函数处理接收到的数据：
WSARecv( m_socket, @FBuf, 1, dwTemp, dwFlag, @m_overlap, WorkerRoutine );
然后......没有什么然后了，系统什么都给你做了！微软真实体贴！
while ( not Terminated ) do//这就是一个Recv/Send线程要做的事情......什么都不用做啊！！！
begin
  if SleepEx( RECV_TIME_OUT, True ) = WAIT_IO_COMPLETION then //
  begin
    ;
  end else
  begin
    continue;
  end;
end;

六：IOCP模型

微软信箱似乎很完美，老陈也很满意。但是在一些大公司情况却完全不同！这些大公司有数以万计的信箱，每秒钟都有数以百计的信件需要处理，以至于微软信箱经常因超负荷运转而崩溃！需要重新启动！微软不得不使出杀手锏......
微软给每个大公司派了一名名叫“Completion Port”的超级机器人，让这个机器人去处理那些信件！

“Windows NT小组注意到这些应用程序的性能没有预料的那么高。特别的，处理很多同时的客户请求意味着很多线程并发地运行在系统中。因为所有这些线程都是可运行的[没有被挂起和等待发生什么事]，Microsoft意识到NT内核花费了太多的时间来转换运行线程的上下文[Context]，线程就没有得到很多CPU时间来做它们的工作。大家可能也都感觉到并行模型的瓶颈在于它为每一个客户请求都创建了一个新线程。创建线程比起创建进程开销要小，但也远不是没有开销的。我们不妨设想一下：如果事先开好N个线程，让它们在那hold[堵塞]，然后可以将所有用户的请求都投递到一个消息队列中去。然后那N个线程逐一从消息队列中去取出消息并加以处理。就可以避免针对每一个用户请求都开线程。不仅减少了线程的资源，也提高了线程的利用率。理论上很不错，你想我等泛泛之辈都能想出来的问题，Microsoft又怎会没有考虑到呢?”-----摘自nonocast的《理解I/O Completion Port》

先看一下IOCP模型的实现：

//创建一个完成端口
FCompletPort := CreateIoCompletionPort( INVALID_HANDLE_VALUE, 0,0,0 );

//接受远程连接，并把这个连接的socket句柄绑定到刚才创建的IOCP上
AConnect := accept( FListenSock, addr, len);
CreateIoCompletionPort( AConnect, FCompletPort, nil, 0 );

//创建CPU数*2 + 2个线程
for i:=1 to si.dwNumberOfProcessors*2+2 do
begin
  AThread := TRecvSendThread.Create( false );
  AThread.CompletPort := FCompletPort;//告诉这个线程，你要去这个IOCP去访问数据
end;

OK，就这么简单，我们要做的就是建立一个IOCP，把远程连接的socket句柄绑定到刚才创建的IOCP上，最后创建n个线程，并告诉这n个线程到这个IOCP上去访问数据就可以了。

再看一下TRecvSendThread线程都干些什么：

procedure TRecvSendThread.Execute;
var
  ......
begin
  while (not self.Terminated) do
  begin
    //查询IOCP状态（数据读写操作是否完成）
    GetQueuedCompletionStatus( CompletPort, BytesTransd, CompletKey, POVERLAPPED(pPerIoDat), TIME_OUT );

    if BytesTransd <> 0  then
       ....;//数据读写操作完成

    //再投递一个读数据请求
    WSARecv( CompletKey, @(pPerIoDat^.BufData), 1, BytesRecv, Flags, @(pPerIoDat^.Overlap), nil );
  end;
end;

读写线程只是简单地检查IOCP是否完成了我们投递的读写操作，如果完成了则再投递一个新的读写请求。
应该注意到，我们创建的所有TRecvSendThread都在访问同一个IOCP（因为我们只创建了一个IOCP），并且我们没有使用临界区！难道不会产生冲突吗？不用考虑同步问题吗？
呵呵，这正是IOCP的奥妙所在。IOCP不是一个普通的对象，不需要考虑线程安全问题。它会自动调配访问它的线程：如果某个socket上有一个线程A正在访问，那么线程B的访问请求会被分配到另外一个socket。这一切都是由系统自动调配的，我们无需过问。

首先，看一看在delphi中用于描述时间的几种数据结构，对时间的操作，其实就是对这些结构的操作。

TDateTime类型：

Delphi中最常用的表示日期时间的数据类型TDateTime类型，和普通的整形数一样，你可以给日期定义一个日期型变量以便在程序中进行操作。TdateTime类型实质上是一个Double型的数，在Delphi中是这样定义TdateTime类型： type  TDateTime = type Double ,具体的算法是用Double数的整数部分表示日期，以1989年12月30日为基准点，以天为单位进行加减，如数字1表示1900年1月1日，数字-1表示1989年12月29日。而小数部分则用来表示时间，其值为欲表示的时间与一整天总时间的比值，如早上6点就是6/24=0.25,而早上6:15就是(6*60+15)/(24*60)=0.2604166666666666666666666666667，下面，给出几个例子说明TDateTime类型与Double类型的交互关系

0       12/30/1899 00:00:00

2.75   1/1/1900 18:00:00

-1.25   12/29/1899 6:00:00

35065   1/1/1996 00:00:00

相信大家一定能自己理解TdateTime与Double之间的转换方法，因此，从根本上对TDateTime的操作与Double完全一样。

TTimeStamp 类型：

这是一个用来描述日期与时间的一个结构类型，在Delphi中是这样定义的：

type

  TTimeStamp = record

    Time: Integer;      {从午夜0点开始到指定时间的毫秒数 }

    Date: Integer;      {以本日为基准到指点日期的天数 }

  end;

和TDateTime相比，可更直观表示高精度的时间，一般用于毫秒级的运算以及用于表示较长的时间。

PsystemTime 类型：

一个用于WinApi中对时间操作的指针型结构。他的定义为：

type

PSystemTime = ^TSystemTime;

TSystemTime = record

  wYear: Word;

  wMonth: Word;

  wDayOfWeek: Word;

  wDay: Word;

  wHour: Word;

  wMinute: Word;

  wSecond: Word;

  wMilliseconds: Word;

end;

这个结构多用于调用WinApi操作时使用。

在了解了各种时间类型的本质后，相信大家都有一套操作这些类型的时间的想法，不过在Delphi中还提供了一整套用于操作时间的过程函数，这些过程和函数都定义在SysUnit这个单元中，现在就向大家介绍Delphi中相关函数：

用于时间操作的函数

Date函数：

定义：Date: TDateTime;

作用：返回当前的日期

范例：CurrentDate := Date;

DayOfWeek函数：

定义：function DayOfWeek(Date: TDateTime): Integer;

作用：得到指定日期的星期值，返回1～7，代表周日到周六。

IncMouth函数：

定义：function IncMonth(const Date: TDateTime; NumberOfMonths: Integer): TDateTime;

作用：求给定的日期Data在NumberOfMonths个月后的日期。

范例：Date1 := IncMonth(date,10);

如果今天是2002-5-3，则Date1就是2003-3-3

IsLeapYear函数：

定义：function IsLeapYear(Year: Word): Boolean;

作用：判断指定的年份是否是闰年；

范例：if isLeapYear(2000) then ShowMessage(‘该年是闰年’);

Now函数：

定义：function Now: TDateTime;

作用：用于取得当前的日期时间

范例：CurrentDateTime := Now;

ReplaceDate 过程

定义：procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime);

作用：使用参数Newdate日期部分替换参数DateTime的日期部分，但不改变时间部分。

ReplaceDate 过程

定义：procedure ReplaceTime(var DateTime: TDateTime; const NewTime: TDateTime);

作用：使用参数Newdate时间部分替换参数DateTime的时间部分，但不改变日期部分。

如果上述这两个过程一起用，就相当于赋值了。

Time函数：

定义：function Time: TDateTime;

作用：返回当前的时间

范例：CurrentTime := Time;

作者： Savetime|savetime2k@yahoo.com     转贴自：Delphibbs.com
目录
===========================================================
⊙ RTTI 简介
⊙ 类(class) 和 VMT 的关系
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
⊙ TObject.ClassType 和 TObject.ClassInfo
⊙ is 和 as 运算符的原理
⊙ TTypeInfo – RTTI 信息的结构
⊙ 获取类(class)的属性(property)信息
⊙ 获取方法(method)的类型信息
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
⊙ 获取其它数据类型的 RTTI 信息
===========================================================
本文排版格式为：
    正文由窗口自动换行；所有代码以 80 字符为边界；中英文字符以空格符分隔。

(作者保留对本文的所有权利，未经作者同意请勿在在任何公共媒体转载。)

正文
===========================================================
⊙ RTTI 简介
===========================================================

RTTI(Run-Time Type Information) 翻译过来的名称是“运行期类型信息”，也就是说可以在运行期获得数据类型或类(class)的信息。这个 RTTI 到底有什么用处，我现在也说不清楚。我是在阅读 Delphi 持续机制的代码中发现了很多 RTTI 的运用，只好先把 RTTI 学习一遍。下面是我的学习笔记。如果你发现了错误请告诉我。谢谢！

Delphi 的 RTTI 主要分为类(class)的 RTTI 和一般数据类型的 RTTI，下面从类(class)开始。

===========================================================
⊙ 类(class) 和 VMT 的关系
===========================================================

一个类(class)，从编译器的角度来看就是一个指向 VMT 的指针(在后文用 VMTptr 表示)。在类的 VMTptr 的负地址方向存储了一些类信息的指针，这些指针的值和指针所指的内容在编译后就确定了。比如 VMTptr - 44 的内容是指向类名称(ClassName)的指针。不过一般不使用数值来访问这些类信息，而是通过 System.pas 中定义的以 vmt 开头的常量，如 vtmClassName、vmtParent 等来访问。

类的方法有两种：对象级别的方法和类级别的方法。两者的 Self 指针意义是不同的。在对象级别的方法中 Self 指向对象地址空间，因此可以用它来访问对象的成员函数；在类级别的方法中 Self 指向类的 VMT，因此只能用它来访问 VMT 信息，而不能访问对象的成员字段。

===========================================================
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
===========================================================

上面说到类(class) 就是 VMTptr。在 Delphi 中还可以用 class of 关键字定义类的类，并且可以使用类的类定义类变量。从语法上理解这三者的关键并不难，把类当成普通的数据类型来考虑就可以了。在编译器级别上表现如何呢？

为了简化讨论，我们使用 TObject、TClass 和 TMyClass 来代表上面说的三种类型：

type
  TClass = class of TObject;
var
  TMyClass: TClass;
  MyObject: TObject;
begin
  TMyClass := TObject;
  MyObject := TObject.Create;
  MyObject := TClass.Create;
  MyObject := TMyClass.Create;
end;
 
在上面的例子中，三个 TObject 对象都被成功地创建了。编译器的实现是：TObject 是一个 VMTPtr 常量。TClass 也是一个 VMTptr 常量，它的值就是 TObject。TMyClass 是一个 VMTptr 变量，它被赋值为 TObject。TObject.Create 与 TClass.Create 的汇编代码完全相同。但 TClass 不仅缺省代表一个类，而且还(主要)代表了类的类型，可以用它来定义类变量，实现一些类级别的操作。

===========================================================
⊙ TObject.ClassType 和 TObject.ClassInfo
===========================================================

function TObject.ClassType: TClass;
begin
  Pointer(Result) := PPointer(Self)^;
end;

TObject.ClassType 是对象级别的方法，Self 的值是指向对象内存空间的指针，对象内存空间的前 4 个字节是类的 VMTptr。因此这个函数的返回值就是类的 VMTptr。

class function TObject.ClassInfo: Pointer;
begin
  Result := PPointer(Integer(Self) + vmtTypeInfo)^;
end;

TObject.ClassInfo 使用 class 关键字定义，因此是一个类级别的方法。该方法中的 Self 指针就是 VMTptr。所以这个函数的返回值是 VMTptr 负方向的 vmtTypeInfo 的内容。

TObject.ClassInfo 返回的 Pointer 指针，实际上是指向类的 RTTI 结构的指针。但是不能访问 TObject.ClassInfo 指向的内容(TObject.ClassInfo 返回值是 0)，因为 Delphi 只在 TPersistent 类及 TPersistent 的后继类中产生 RTTI 信息。(从编译器的角度来看，这是在 TPersistent 类的声明之前使用 {$M+} 指示字的结果。)

TObject 还定义了一些获取类 RTTI 信息的函数，列举在下，就不一一分析了：

  TObject.ClassName: ShortString;   类的名称
  TObject.ClassParent: TClass;      对象的父类
  TObject.InheritsFrom: Boolean;    是否继承自某类
  TObject.InstanceSize: Longint;    对象实例的大小

===========================================================
⊙ is 和 as 运算符的原理
===========================================================

我们知道可以在运行期使用 is 关键字判断一个对象是否属于某个类，可以使用 as 关键字把某个对象安全地转换为某个类。在编译器的层次上，is 和 as 的操作是由 System.pas 中两个函数完成的。

{ System.pas }
function _IsClass(Child: TObject; Parent: TClass): Boolean;
begin
  Result := (Child <> nil) and Child.InheritsFrom(Parent);
end;

_IsClass 很简单，它使用 TObject 的 InheritsForm 函数判断该对象是否是从某个类或它的父类中继承下来的。每个类的 VMT 中都有一项 vmtParent 指针，指向该类的父类的 VMT。TObject.InheritsFrom 实际上是通过[递归]判断父类 VMT 指针是否等于自己的 VMT 指针来判断是否是从该类继承的。

{ System.pas }
class function TObject.InheritsFrom(AClass: TClass): Boolean;
var
  ClassPtr: TClass;
begin
  ClassPtr := Self;
  while (ClassPtr <> nil) and (ClassPtr <> AClass) do
    ClassPtr := PPointer(Integer(ClassPtr) + vmtParent)^;
  Result := ClassPtr = AClass;
end;

as 操作符实际上是由 System.pas 中的 _AsClass 函数完成的。它简单地调用 is 操作符判断对象是否属于某个类，如果不是就触发异常。虽然 _AsClass 返回值为 TObject 类型，但编译器会自动把返回的对象改变为 Parent 类，否则返回的对象没有办法使用 TObject 之外的方法和数据。

{ System.pas }
function _AsClass(Child: TObject; Parent: TClass): TObject;
begin
  Result := Child;
  if not (Child is Parent) then
    Error(reInvalidCast);   // loses return address
end;

===========================================================
⊙ TTypeInfo – RTTI 信息的结构
===========================================================

RTTI 信息的结构定义在 TypInfo.pas 中：

  TTypeInfo = record        // TTypeInfo 是 RTTI 信息的结构
    Kind: TTypeKind;        // RTTI 信息的数据类型
    Name: ShortString;      // 数据类型的名称
   {TypeData: TTypeData}    // RTTI 的内容
  end;

TTypeInfo 就是 RTTI 信息的结构。TObject.ClassInfo 返回指向存放 class TTypeInfo 信息的指针。Kind 是枚举类型，它表示 RTTI 结构中所包含数据类型。Name 是数据类型的名称。注意，最后一个字段 TypeData 被注释掉了，这说明该处的结构内容根据不同的数据类型有所不同。

TTypeKind 枚举定义了可以使用 RTTI 信息的数据类型，它几乎包含了所有的 Delphi 数据类型，其中包括 tkClass。

  TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);

TTypeData 是个巨大的记录类型，在此不再列出，后文会根据需要列出该记录的内容。

===========================================================
⊙ 获取类(class)的属性(property)信息
===========================================================

这一段是 RTTI 中最复杂的部分，努力把本段吃透，后面的内容都是非常简单的。

下面是一个获取类的属性的例子：

procedure GetClassProperties(AClass: TClass; AStrings: TStrings);
var
  PropCount, I: SmallInt;
  PropList: PPropList;
  PropStr: string;
begin
  PropCount := GetTypeData(AClass.ClassInfo).PropCount;
  GetPropList(AClass.ClassInfo, PropList);
  for I := 0 to PropCount - 1 do
  begin
    case PropList[I]^.PropType^.Kind of
      tkClass      : PropStr := '[Class] ';
      tkMethod     : PropStr := '[Method]';
      tkSet        : PropStr := '[Set]   ';
      tkEnumeration: PropStr := '[Enum]  ';
    else
      PropStr := '[Field] ';
    end;
    PropStr := PropStr + PropList[I]^.Name;
    PropStr := PropStr + ': ' + PropList[I]^.PropType^.Name;
    AStrings.Add(PropStr);
  end;
  FreeMem(PropList);
end;

你可以在表单上放置一个 TListBox ，然后执行以下语句观察执行结果：

  GetClassProperties(TForm1, ListBox1.Items);

该函数先使用 GetTypeData 函数获得类的属性数量。GetTypeData 是 TypInfo.pas 中的一个函数，它的功能是返回 TTypeInfo 的 TypeData 数据的指针：

{ TypInfo.pas }
function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;

class 的 TTypeData 结构如下：

  TTypeData = packed record
    case TTypeKind of
      tkClass: (
        ClassType: TClass;         // 类 (VMTptr)
        ParentInfo: PPTypeInfo;    // 父类的 RTTI 指针
        PropCount: SmallInt;       // 属性数量
        UnitName: ShortStringBase; // 单元的名称
       {PropData: TPropData});     // 属性的详细信息
  end;

其中的 PropData 又是一个大小可变的字段。TPropData 的定义如下：

  TPropData = packed record
    PropCount: Word;       // 属性数量
    PropList: record end;  // 占位符，真正的意义在下一行
    {PropList: array[1..PropCount] of TPropInfo}
  end;

每个属性信息在内存中的结构就是 TPropInfo，它的定义如下：

  PPropInfo = ^TPropInfo;
  TPropInfo = packed record
    PropType: PPTypeInfo;    // 属性类型信息指针的指针
    GetProc: Pointer;        // 属性的 Get 方法指针
    SetProc: Pointer;        // 属性的 Set 方法指针
    StoredProc: Pointer;     // 属性的 StoredProc 指针
    Index: Integer;          // 属性的 Index 值
    Default: Longint;        // 属性的 Default 值
    NameIndex: SmallInt;     // 属性的名称索引(以 0 开始计数)
    Name: ShortString;       // 属性的名称
  end;

为了方便访问属性信息，TypInfo.pas 中还定义了指向 TPropInfo 数组的指针：

  PPropList = ^TPropList;
  TPropList = array[0..16379] of PPropInfo;

我们可以使用 GetPropList 获得所有属性信息的指针数组，数组用完以后要记得用 FreeMem 把数组的内存清除。

{ TypInfo.pas }
function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer;

GetPropList 传入类的 TTypeInfo 指针和 TPropList 的指针，它为 PropList 分配一块内存后把该内存填充为指向 TPropInfo 的指针数组，最后返回属性的数量。

上面的例子演示了如何获得类的所有属性信息，也可以根据属性的名称单独获得属性信息：

{ TypInfo.pas }
function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;

GetPropInfo 根据类的 RTTI 指针和属性的名称字符串，返回属性的信息 TPropInfo 的指针。如果没有找到该属性，则返回 nil。GetPropInfo 很容易使用，举个例子：

  ShowMessage(GetPropInfo(TForm, 'Name')^.PropType^.Name);

这句调用显示了 TForm 类的 Name 属性的类型名称：TComponentName。

===========================================================
⊙ 获取方法(method)的类型信息
===========================================================

所谓方法就是以 of object 关键字声明的函数指针，下面的函数可以显示一个方法的类型信息：

procedure GetMethodTypeInfo(ATypeInfo: PTypeInfo; AStrings: TStrings);
type
  PParamData = ^TParamData;
  TParamData = record       // 函数参数的数据结构
    Flags: TParamFlags;     // 参数传递规则
    ParamName: ShortString; // 参数的名称
    TypeName: ShortString;  // 参数的类型名称
  end;
  function GetParamFlagsName(AParamFlags: TParamFlags): string;
  var
    I: Integer;
  begin
    Result := '';
    for I := Integer(pfVar) to Integer(pfOut) do begin
      if I = Integer(pfAddress) then Continue;
      if TParamFlag(I) in AParamFlags then
        Result := Result + ' ' + GetEnumName(TypeInfo(TParamFlag), I);
    end;
  end;
var
  MethodTypeData: PTypeData;
  ParamData: PParamData;
  TypeStr: PShortString;
  I: Integer;
begin
  MethodTypeData := GetTypeData(ATypeInfo);
  AStrings.Add('---------------------------------');
  AStrings.Add('Method Name: ' + ATypeInfo^.Name);
  AStrings.Add('Method Kind: ' + GetEnumName(TypeInfo(TMethodKind),
    Integer(MethodTypeData^.MethodKind)));
  AStrings.Add('Params Count: '+ IntToStr(MethodTypeData^.ParamCount));
  AStrings.Add('Params List:');
  ParamData := PParamData(@MethodTypeData^.ParamList);
  for I := 1 to MethodTypeData^.ParamCount do
  begin
    TypeStr := Pointer(Integer(@ParamData^.ParamName) +
      Length(ParamData^.ParamName) + 1);
    AStrings.Add(Format('  [%s] %s: %s',[GetParamFlagsName(ParamData^.Flags),
      ParamData^.ParamName, TypeStr^]));
    ParamData := PParamData(Integer(ParamData) + SizeOf(TParamFlags) +
      Length(ParamData^.ParamName) + Length(TypeStr^) + 2);
  end;
  if MethodTypeData^.MethodKind = mkFunction then
    AStrings.Add('Result Value: ' + PShortString(ParamData)^);
end;

作为实验，在表单上放置一个 TListBox，然后执行以下代码，观察执行结果：

type
  TMyMethod = function(A: array of Char; var B: TObject): Integer of object;
procedure TForm1.FormCreate(Sender: TObject);
begin
  GetMethodTypeInfo(TypeInfo(TMyMethod), ListBox1.Items);
  GetMethodTypeInfo(TypeInfo(TMouseEvent), ListBox1.Items);
  GetMethodTypeInfo(TypeInfo(TKeyPressEvent), ListBox1.Items);
  GetMethodTypeInfo(TypeInfo(TMouseWheelEvent), ListBox1.Items);
end;

由于获取方法的类型信息比较复杂，我尽量压缩代码也还是有这么长，让我们看看它的实现原理。GetMethodTypeInfo 的第一个参数是 PTypeInfo 类型，表示方法的类型信息地址。第二个参数是一个字符串列表，可以使用任何实现 TStrings 操作的对象。我们可以使用 System.pas 中的 TypeInfo 函数获得任何类型的 RTTI 信息指针。TypeInfo 函数像 SizeOf 一样，是内置于编译器中的。

GetMethodTypeInfo 还用到了 TypInfo.pas 中的 GetEnumName 函数。这个函数通过枚举类型的整数值得到枚举类型的名称。

function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;

与获取类(class)的属性信息类似，方法的类型信息也在 TTypeData 结构中

  TTypeData = packed record
    case TTypeKind of
      tkMethod: (
        MethodKind: TMethodKind;            // 方法指针的类型
        ParamCount: Byte;                   // 参数数量
        ParamList: array[0..1023] of Char   // 参数详细信息，见下行注释
       {ParamList: array[1..ParamCount] of
          record
            Flags: TParamFlags;             // 参数传递规则
            ParamName: ShortString;         // 参数的名称
            TypeName: ShortString;          // 参数的类型
          end;
        ResultType: ShortString});          // 返回值的名称
  end;

TMethodKind 是方法的类型，定义如下：

  TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
    mkClassProcedure, mkClassFunction,
    { Obsolete }
    mkSafeProcedure, mkSafeFunction);

TParamsFlags 是参数传递的规则，定义如下：

  TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  TParamFlags = set of TParamFlag;

由于 ParamName 和 TypeName 是变长字符串，不能直接取用该字段的值，而应该使用指针步进的方法，取出参数信息，所以上面的代码显得比较长。

===========================================================
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
===========================================================

讨论完了属性和方法的 RTTI 信息之后再来看其它数据类型的 RTTI 就简单多了。所有获取 RTTI 的原理都是通过 GetTypeData 函数得到 TTypeData 的指针，再通过 TTypeInfo.TypeKind 来解析 TTypeData。任何数据类型的 TTypeInfo 指针可以通过 TypeInfo 函数获得。

有序类型的 TTypeData 定义如下：

TTypeData = packed record
  tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
    OrdType: TOrdType;         // 有序数值类型
    case TTypeKind of
      case TTypeKind of
        tkInteger, tkChar, tkEnumeration, tkWChar: (
          MinValue: Longint;   // 类型的最小值
          MaxValue: Longint;   // 类型的最大值
          case TTypeKind of
            tkInteger, tkChar, tkWChar: ();
            tkEnumeration: (
              BaseType: PPTypeInfo;      // 指针的指针，它指向枚举的 PTypeInfo
              NameList: ShortStringBase;     // 枚举的名称字符串(不能直接取用)
              EnumUnitName: ShortStringBase)); // 所在的单元名称(不能直接取用)
          tkSet: (
            CompType: PPTypeInfo));            // 指向集合基类 RTTI 指针的指针
end;

下面是一个获取有序类型和集合类型的 RTTI 信息的函数：

procedure GetOrdTypeInfo(ATypeInfo: PTypeInfo; AStrings: TStrings);
var
  OrdTypeData: PTypeData;
  I: Integer;
begin
  OrdTypeData := GetTypeData(ATypeInfo);
  AStrings.Add('------------------------------------');
  AStrings.Add('Type Name: ' + ATypeInfo^.Name);
  AStrings.Add('Type Kind: ' + GetEnumName(TypeInfo(TTypeKind),
    Integer(ATypeInfo^.Kind)));
  AStrings.Add('Data Type: ' + GetEnumName(TypeInfo(TOrdType),
    Integer(OrdTypeData^.OrdType)));
  if ATypeInfo^.Kind <> tkSet then begin
    AStrings.Add('Min Value: ' + IntToStr(OrdTypeData^.MinValue));
    AStrings.Add('Max Value: ' + IntToStr(OrdTypeData^.MaxValue));
  end;
  if ATypeInfo^.Kind = tkSet then
    GetOrdTypeInfo(OrdTypeData^.CompType^, AStrings);
  if ATypeInfo^.Kind = tkEnumeration then
    for I := OrdTypeData^.MinValue to OrdTypeData^.MaxValue do
      AStrings.Add(Format('  Value %d: %s', [I, GetEnumName(ATypeInfo, I)]));
end;

在表单上放置一个 TListBox，运行以下代码查看结果：

type TMyEnum = (EnumA, EnumB, EnumC);
procedure TForm1.FormCreate(Sender: TObject);
begin
  GetOrdTypeInfo(TypeInfo(Char), ListBox1.Items);
  GetOrdTypeInfo(TypeInfo(Integer), ListBox1.Items);
  GetOrdTypeInfo(TypeInfo(TFormBorderStyle), ListBox1.Items);
  GetOrdTypeInfo(TypeInfo(TBorderIcons), ListBox1.Items);
  GetOrdTypeInfo(TypeInfo(TMyEnum), ListBox1.Items);
end;

(如果枚举元素没有按缺省的 0 基准定义，那么将不能产生 RTTI 信息，为什么？)

===========================================================
⊙ 获取其它数据类型的 RTTI 信息
===========================================================

上面讨论了几个典型的 RTTI 信息的运行，其它的数据类型的 RTTI 信息的获取方法与上面类似。由于这些操作更加简单，就不一一讨论。下面概述其它类型的 RTTI 信息的情况：

LongString、WideString 和 Variant 没有 RTTI 信息；
ShortString 只有 MaxLength 信息；
浮点数类型只有 FloatType: TFloatType 信息；
  TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
Int64 只有最大值和最小值信息(也是 64 位整数表示)；
Interface 和动态数组不太熟悉，就不作介绍了。

===========================================================
⊙ 结束
==========================================================