TObject

 http://hi.baidu.com/fefesoft/item/e08767f158725b08d89e72d9

TObject = class

    //創建
    constructor Create;
    //釋放
    procedure Free;
    //初始化實列
    class function InitInstance(Instance: Pointer): TObject;
    //清除實列
    procedure CleanupInstance;
    //獲得類的類型
    function ClassType: TClass;
    //獲得了的名稱
    class function ClassName: ShortString;
    //判斷類的名稱
    class function ClassNameIs(const Name: string): Boolean;
    //類的父類
    class function ClassParent: TClass;
    //類的信息指針
    class function ClassInfo: Pointer;
    //當前類的實列大小
    class function InstanceSize: Longint;
    //判斷是否從一個類繼承下來
    class function InheritsFrom(AClass: TClass): Boolean;
    //根據方法的名稱獲得方法的地址
    class function MethodAddress(const Name: ShortString): Pointer;
    //根據地址或的方法的名稱
    class function MethodName(Address: Pointer): ShortString;
    //根據名稱獲得屬性的地址
    function FieldAddress(const Name: ShortString): Pointer;
    //查詢接口
    function GetInterface(const IID: TGUID; out Obj): Boolean;
    //獲得接口的入口
    class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
    //獲得接口表
    class function GetInterfaceTable: PInterfaceTable;
    //安全調用例外
    function SafeCallException(ExceptObject: TObject;
      ExceptAddr: Pointer): HResult; virtual;
    //創建之後的執行
    procedure AfterConstruction; virtual;
    //釋放之前的執行
    procedure BeforeDestruction; virtual;
    //分派消息
    procedure Dispatch(var Message); virtual;
    //默認的句柄
    procedure DefaultHandler(var Message); virtual;
    //新的實列
    class function NewInstance: TObject; virtual;
    //釋放實列
    procedure FreeInstance; virtual;
    //釋放
    destructor Destroy; virtual;
  end;



//初始化實列
class function TObject.InitInstance(Instance: Pointer): TObject;
{$IFDEF PUREPASCAL}
var
  IntfTable: PInterfaceTable;
  ClassPtr: TClass;
  I: Integer;
begin
  //分配需要的內存的大小
  FillChar(Instance^, InstanceSize, 0);
  //實列化分配好的內存
  PInteger(Instance)^ := Integer(Self);
  ClassPtr := Self;
  //如果成功
  while ClassPtr <> nil do
  begin
    //獲得接口表
    IntfTable := ClassPtr.GetInterfaceTable;
    //遍歷接口
    if IntfTable <> nil then
      for I := 0 to IntfTable.EntryCount-1 do
  //初始化每個接口函數的具體實現
  with IntfTable.Entries[I] do
  begin
    if VTable <> nil then
      PInteger(@PChar(Instance)[IOffset])^ := Integer(VTable);
  end;
    ClassPtr := ClassPtr.ClassParent;
  end;
  Result := Instance;
end;

//清除實列
procedure TObject.CleanupInstance;
{$IFDEF PUREPASCAL}
var
  ClassPtr: TClass;
  InitTable: Pointer;
begin
  //獲得當前的類型
  ClassPtr := ClassType;
  //獲得初始化標的地址  
  InitTable := PPointer(Integer(ClassPtr) + vmtInitTable)^;
  //如果當前類存在  並且初始化表也存在
  while (ClassPtr <> nil) and (InitTable <> nil) do
  begin
    //釋放所有的信息
    _FinalizeRecord(Self, InitTable);
    //如果當前類有父類 則清楚父類的信息
    ClassPtr := ClassPtr.ClassParent;
    if ClassPtr <> nil then
      InitTable := PPointer(Integer(ClassPtr) + vmtInitTable)^;
  end;
end;

//獲得當前類的類型
function TObject.ClassType: TClass;
begin
  //就是返回當前類的指針
  Pointer(Result) := PPointer(Self)^;
end;

//獲得當前類的類名
class function TObject.ClassName: ShortString;
{$IFDEF PUREPASCAL}
begin
  //根據虛擬方發表返回指定的地址
  Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;
end;

// 判斷當前類的類名
class function TObject.ClassNameIs(const Name: string): Boolean;
{$IFDEF PUREPASCAL}
var
  Temp: ShortString;
  I: Byte;
begin
  Result := False;
  //獲得當前類的類名得指針
  Temp := ClassName;
  //根據字符串的長度比較每個字符 區分大小寫
  for I := 0 to Byte(Temp[0]) do
    if Temp[I] <> Name[I] then Exit;
  Result := True;
end;

//獲得當前類的父類
class function TObject.ClassParent: TClass;
{$IFDEF PUREPASCAL}
begin
  //根據虛擬方法表或的父的地址指針
  Pointer(Result) := PPointer(Integer(Self) + vmtParent)^;
  //如果存在父類 則返回
  if Result <> nil then
    Pointer(Result) := PPointer(Result)^;
end;
{$ELSE}
asm
        MOV     EAX,[EAX].vmtParent
        TEST    EAX,EAX
        JE      @@exit
        MOV     EAX,[EAX]
@@exit:
end;

//獲得類型信息
class function TObject.ClassInfo: Pointer;
begin
  Result := PPointer(Integer(Self) + vmtTypeInfo)^;
end;

//獲得實列大小
class function TObject.InstanceSize: Longint;
begin
  Result := PInteger(Integer(Self) + vmtInstanceSize)^;
end;

//判斷是否從一個類繼承下來
class function TObject.InheritsFrom(AClass: TClass): Boolean;
{$IFDEF PUREPASCAL}
var
  ClassPtr: TClass;
begin
  ClassPtr := Self;
  //當前類是否存在 並且和比較的類不等 
  while (ClassPtr <> nil) and (ClassPtr <> AClass) do
     //獲得這個類的父類
    ClassPtr := PPointer(Integer(ClassPtr) + vmtParent)^;
  Result := ClassPtr = AClass;
end;
{$ELSE}
asm
        { ->    EAX     Pointer to our class    }
        {       EDX     Pointer to AClass               }
        { <-    AL      Boolean result          }
        JMP     @@haveVMT
@@loop:
        MOV     EAX,[EAX]
@@haveVMT:
        CMP     EAX,EDX
        JE      @@success
        MOV     EAX,[EAX].vmtParent
        TEST    EAX,EAX
        JNE     @@loop
        JMP     @@exit
@@success:
        MOV     AL,1
@@exit:
end;

//根據方法名稱獲得地址
class function TObject.MethodAddress(const Name: ShortString): Pointer;
asm
        { ->    EAX     Pointer to class        }
        {       EDX     Pointer to name }
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        XOR     ECX,ECX           //清零
        XOR     EDI,EDI           //清零
        MOV     BL,[EDX]          //獲得字符串的長度
        JMP     @@haveVMT         //判斷是否有虛擬方發表
@@outer:                                { upper 16 bits of ECX are 0 !  }
        MOV     EAX,[EAX]
@@haveVMT:
        MOV     ESI,[EAX].vmtMethodTable  //獲得虛擬方發表的地址
        TEST    ESI,ESI                   //是否存在
        JE      @@parent                  //如果不存在
        MOV     DI,[ESI]                { EDI := method count           }方法的數量
        ADD     ESI,2                     // 開始  
@@inner:                                { upper 16 bits of ECX are 0 !  }
        MOV     CL,[ESI+6]              { compare length of strings     }  //獲得名城的長度
        CMP     CL,BL                                                      //比較長度 
        JE      @@cmpChar                                                  //如果相等就開始比較字符
@@cont:                                 { upper 16 bits of ECX are 0 !  }
        MOV     CX,[ESI]                { fetch length of method desc   }  //獲得方法的長度  //長度兩個字節 指針4個字節  ///
        ADD     ESI,ECX                 { point ESI to next method      }  //指向下一個函數
        DEC     EDI
        JNZ     @@inner
@@parent:                              //獲得父的方發表
        MOV     EAX,[EAX].vmtParent     { fetch parent vmt              }
        TEST    EAX,EAX                //是否爲0 
        JNE     @@outer                //不爲零
        JMP     @@exit                  { return NIL                    }  //已經到根

@@notEqual:
        MOV     BL,[EDX]                { restore BL to length of name  } //存儲名字的長度
        JMP     @@cont                                                    //轉移 

@@cmpChar:                              { upper 16 bits of ECX are 0 !  }
        MOV     CH,0                    { upper 24 bits of ECX are 0 !  }  ///清空高位字節
@@cmpCharLoop:
        MOV     BL,[ESI+ECX+6]          { case insensitive string cmp   }  //獲得第一個字符
        XOR     BL,[EDX+ECX+0]          { last char is compared first   }  //比較
        AND     BL,$DF                                                     //清空其他標誌位  
        JNE     @@notEqual
        DEC     ECX                      { ECX serves as counter         } //比較下一個
        JNZ     @@cmpCharLoop                                              //如果不爲零 進行下一個字符的比較

        { found it }
        MOV     EAX,[ESI+2]              //找到 並且得到指針 12 方法長度 3456 方法指針 7890 方法名稱 7 方法名城的長度

@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
end; 

//根據字段名獲得地址
function TObject.FieldAddress(const Name: ShortString): Pointer;
asm
  { ->    EAX     Pointer to instance     }
        {       EDX     Pointer to name }
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        XOR     ECX,ECX                 //清空Cx 
        XOR     EDI,EDI                 //清空Edit                     
        MOV     BL,[EDX]                //獲得Name的長度

        PUSH    EAX                     { save instance pointer         }  //保存當前實列指針

@@outer:
        MOV     EAX,[EAX]               { fetch class pointer           } //獲得當前類的指針
        MOV     ESI,[EAX].vmtFieldTable                                   //獲得字段列表的地址
        TEST    ESI,ESI                                                   //是否存在
        JE      @@parent                                                  //如果不存在就到當前的父類查找
        MOV     DI,[ESI]                { fetch count of fields         } //獲得字段的數量
        ADD     ESI,6                                                     // 2 爲數量 4 位指針 
@@inner:
        MOV     CL,[ESI+6]              { compare string lengths        } //獲得當前字段的長度
        CMP     CL,BL                                                     //比較長度
        JE      @@cmpChar                                                 //如果相等 就開始比較 字符
@@cont:  ///LEA是取變量的地址 
        LEA     ESI,[ESI+ECX+7] { point ESI to next field       }         //Esi指向下一個字段ESI 當前位子+ECX 長度+7 ？？？
        DEC     EDI                                                       //數量減一
        JNZ     @@inner                                                   //如果不等於零則繼續比較
@@parent: 
        MOV     EAX,[EAX].vmtParent     { fetch parent VMT              } //獲得當前的父類地址
        TEST    EAX,EAX                                                   //是否存在   
        JNE     @@outer                                                   //如果存在則準備獲得字段數量 
        POP     EDX                     { forget instance, return Nil   } //否則恢復Edx  恢復實列 返回nil 當前Eax爲空
        JMP     @@exit                                                    //並且退出   

@@notEqual:
        MOV     BL,[EDX]                { restore BL to length of name  } //獲得目的字段名稱的長度
        MOV     CL,[ESI+6]              { ECX := length of field name   } //獲得源字段名城的長度
        JMP     @@cont                                                    

@@cmpChar:
        MOV     BL,[ESI+ECX+6]  { case insensitive string cmp   }          //字符比較
        XOR     BL,[EDX+ECX+0]  { starting with last char       }
        AND     BL,$DF                                                     //標誌位處理
        JNE     @@notEqual                                                 //如果不等
        DEC     ECX                     { ECX serves as counter         }  //字符長度減一
        JNZ     @@cmpChar                                                  //如果還有沒有比較完的字符

        { found it }
        MOV     EAX,[ESI]           { result is field offset plus ...   }  //獲得當前的地址的偏移量
        POP     EDX                                                        //恢復當前實列到Edx
        ADD     EAX,EDX         { instance pointer              }          //獲得字段的偏移地址

@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
end; 


//

function TObject.GetInterface(const IID: TGUID; out Obj): Boolean;
var
  InterfaceEntry: PInterfaceEntry;
begin
  Pointer(Obj) := nil;
  InterfaceEntry := GetInterfaceEntry(IID);
  if InterfaceEntry <> nil then
  begin
    if InterfaceEntry^.IOffset <> 0 then
    begin
      Pointer(Obj) := Pointer(Integer(Self) + InterfaceEntry^.IOffset);
      if Pointer(Obj) <> nil then IInterface(Obj)._AddRef;
    end
    else
      IInterface(Obj) := InvokeImplGetter(Self, InterfaceEntry^.ImplGetter);
  end;
  Result := Pointer(Obj) <> nil;
end;

















----------------------
一個實列的創建過程
  s:=Tstrings.create ;
  Mov Dl ,$01,
  Mov Eax , [$00412564];  //？？
  Call Tobject.create ;
    {
     Test dl,dl ;
     Jz +$08    ///???
     Add Esp,-$10;
     Call @ClassCreate;
     { 
       push   Edx,
       Push   Ecx,
       Push   Ebx,
       Test Dl,dl 
       jl   +03
       Call Dword Ptr[eax-$0c]
         { 
           NewInStance
           push Ebx
           mov Ebx ,eax
           mov Eax ,ebx
           Call Tobject.instancesize
             {
              Add Eax,-$28
              Mov Eax,[Eax]
              Ret                           
              }
           Call @GetMem
             {
              push Ebx
              Test Eax,Eax
              jle +$15
              Call Dword ptr [memoryManager]
              Mov Ebx,Eax
              Test Ebx,ebx
              Jnz +$0B
              mov Al,%01
              Call Error
              Xor Ebx,Ebx
              pop Ebx
              Ret
              }
           mov Edx,Eax
           Mov Eax,Ebx,
           call Tobject.initInstance
           pop Ebx            
          
           }
       Xor  Edx,edx
       Lea Ecx,[Esp+$10]
       Mov  Ebx,Fs:[Edx]
       mov [Ecx],EDx
       mov [Ecx+$08],ebx
       mov [Ecx+$04],$0040340D
       mov Fs:[Edx] , Ecx
       pop Ebx
       pop Ecx
       pop Edx
      }
         
        } 
     Test dl,dl,
     jz +0f 
     Call @AfterConStruction
     pop Dword ptr Fs:[$00000000]
     Add  Esp ,$0c    
    }