TObject = class

//創(chuàng)建

constructor Create;

//釋放

procedure Free;

//初始化實(shí)列

class function InitInstance(Instance: Pointer): TObject;

//清除實(shí)列

procedure CleanupInstance;

//獲得類的類型

function ClassType: TClass;

//獲得了的名稱

class function ClassName: ShortString;

//判斷類的名稱

class function ClassNameIs(const Name: string): Boolean;

//類的父類

class function ClassParent: TClass;

//類的信息指針

class function ClassInfo: Pointer;

//當(dāng)前類的實(shí)列大小

class function InstanceSize: Longint;

//判斷是否從一個(gè)類繼承下來

class function InheritsFrom(AClass: TClass): Boolean;

//根據(jù)方法的名稱獲得方法的地址

class function MethodAddress(const Name: ShortString): Pointer;

//根據(jù)地址或的方法的名稱

class function MethodName(Address: Pointer): ShortString;

//根據(jù)名稱獲得屬性的地址

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;

//安全調(diào)用例外

function SafeCallException(ExceptObject: TObject;

ExceptAddr: Pointer): HResult; virtual;

//創(chuàng)建之后的執(zhí)行

procedure AfterConstruction; virtual;

//釋放之前的執(zhí)行

procedure BeforeDestruction; virtual;

//分派消息

procedure Dispatch(var Message); virtual;

//默認(rèn)的句柄

procedure DefaultHandler(var Message); virtual;

//新的實(shí)列

class function NewInstance: TObject; virtual;

//釋放實(shí)列

procedure FreeInstance; virtual;

//釋放

destructor Destroy; virtual;

end;







//初始化實(shí)列

class function TObject.InitInstance(Instance: Pointer): TObject;

{$IFDEF PUREPASCAL}

var

IntfTable: PInterfaceTable;

ClassPtr: TClass;

I: Integer;

begin

//分配需要的內(nèi)存的大小

FillChar(Instance^, InstanceSize, 0);

//實(shí)列化分配好的內(nèi)存

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

//初始化每個(gè)接口函數(shù)的具體實(shí)現(xiàn)

with IntfTable.Entries[I] do

begin

if VTable <> nil then

PInteger(@PChar(Instance)[IOffset])^ := Integer(VTable);

end;

ClassPtr := ClassPtr.ClassParent;

end;

Result := Instance;

end;



//清除實(shí)列

procedure TObject.CleanupInstance;

{$IFDEF PUREPASCAL}

var

ClassPtr: TClass;

InitTable: Pointer;

begin

//獲得當(dāng)前的類型

ClassPtr := ClassType;

//獲得初始化標(biāo)的地址 

InitTable := PPointer(Integer(ClassPtr) + vmtInitTable)^;

//如果當(dāng)前類存在  并且初始化表也存在

while (ClassPtr <> nil) and (InitTable <> nil) do

begin

//釋放所有的信息

_FinalizeRecord(Self, InitTable);

//如果當(dāng)前類有父類 則清楚父類的信息

ClassPtr := ClassPtr.ClassParent;

if ClassPtr <> nil then

InitTable := PPointer(Integer(ClassPtr) + vmtInitTable)^;

end;

end;



//獲得當(dāng)前類的類型

function TObject.ClassType: TClass;

begin

//就是返回當(dāng)前類的指針

Pointer(Result) := PPointer(Self)^;

end;



//獲得當(dāng)前類的類名

class function TObject.ClassName: ShortString;

{$IFDEF PUREPASCAL}

begin

//根據(jù)虛擬方發(fā)表返回指定的地址

Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;

end;



// 判斷當(dāng)前類的類名

class function TObject.ClassNameIs(const Name: string): Boolean;

{$IFDEF PUREPASCAL}

var

Temp: ShortString;

I: Byte;

begin

Result := False;

//獲得當(dāng)前類的類名得指針

Temp := ClassName;

//根據(jù)字符串的長度比較每個(gè)字符 區(qū)分大小寫

for I := 0 to Byte(Temp[0]) do

if Temp[I] <> Name[I] then Exit;

Result := True;

end;



//獲得當(dāng)前類的父類

class function TObject.ClassParent: TClass;

{$IFDEF PUREPASCAL}

begin

//根據(jù)虛擬方法表或的父的地址指針

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;



//獲得實(shí)列大小

class function TObject.InstanceSize: Longint;

begin

Result := PInteger(Integer(Self) + vmtInstanceSize)^;

end;



//判斷是否從一個(gè)類繼承下來

class function TObject.InheritsFrom(AClass: TClass): Boolean;

{$IFDEF PUREPASCAL}

var

ClassPtr: TClass;

begin

ClassPtr := Self;

//當(dāng)前類是否存在 并且和比較的類不等

while (ClassPtr <> nil) and (ClassPtr <> AClass) do

//獲得這個(gè)類的父類

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;



//根據(jù)方法名稱獲得地址

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         //判斷是否有虛擬方發(fā)表

@@outer:                                { upper 16 bits of ECX are 0 !  }

MOV     EAX,[EAX]

@@haveVMT:

MOV     ESI,[EAX].vmtMethodTable  //獲得虛擬方發(fā)表的地址

TEST    ESI,ESI                   //是否存在

JE      @@parent                  //如果不存在

MOV     DI,[ESI]                { EDI := method count           }方法的數(shù)量

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   }  //獲得方法的長度  //長度兩個(gè)字節(jié)指針4個(gè)字節(jié)  ///

ADD     ESI,ECX                 { point ESI to next method      }  //指向下一個(gè)函數(shù)

DEC     EDI

JNZ     @@inner

@@parent:                              //獲得父的方發(fā)表

MOV     EAX,[EAX].vmtParent     { fetch parent vmt              }

TEST    EAX,EAX                //是否為0

JNE     @@outer                //不為零

JMP     @@exit                  { return NIL                    }  //已經(jīng)到根



@@notEqual:

MOV     BL,[EDX]                { restore BL to length of name  } //存儲(chǔ)名字的長度

JMP     @@cont                                                    //轉(zhuǎn)移



@@cmpChar:                              { upper 16 bits of ECX are 0 !  }

MOV     CH,0                    { upper 24 bits of ECX are 0 !  }  ///清空高位字節(jié)

@@cmpCharLoop:

MOV     BL,[ESI+ECX+6]          { case insensitive string cmp   }  //獲得第一個(gè)字符

XOR     BL,[EDX+ECX+0]          { last char is compared first   }  //比較

AND     BL,$DF                                                     //清空其他標(biāo)志位 

JNE     @@notEqual

DEC     ECX                      { ECX serves as counter         } //比較下一個(gè)

JNZ     @@cmpCharLoop                                              //如果不為零 進(jìn)行下一個(gè)字符的比較



{ found it }

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



@@exit:

POP     EDI

POP     ESI

POP     EBX

end;



//根據(jù)字段名獲得地址

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         }  //保存當(dāng)前實(shí)列指針



@@outer:

MOV     EAX,[EAX]               { fetch class pointer           } //獲得當(dāng)前類的指針

MOV     ESI,[EAX].vmtFieldTable                                   //獲得字段列表的地址

TEST    ESI,ESI                                                   //是否存在

JE      @@parent                                                  //如果不存在就到當(dāng)前的父類查找

MOV     DI,[ESI]                { fetch count of fields         } //獲得字段的數(shù)量

ADD     ESI,6                                                     // 2 為數(shù)量 4 位指針

@@inner:

MOV     CL,[ESI+6]              { compare string lengths        } //獲得當(dāng)前字段的長度

CMP     CL,BL                                                     //比較長度

JE      @@cmpChar                                                 //如果相等 就開始比較 字符

@@cont:  ///LEA是取變量的地址
LEA ESI,[ESI+ECX+7] { point ESI to next field } //Esi指向下一個(gè)字段ESI 當(dāng)前位子+ECX 長度+7 ？？？

DEC     EDI                                                       //數(shù)量減一

JNZ     @@inner                                                   //如果不等于零則繼續(xù)比較

@@parent:

MOV     EAX,[EAX].vmtParent     { fetch parent VMT              } //獲得當(dāng)前的父類地址

TEST    EAX,EAX                                                   //是否存在  

JNE     @@outer                                                   //如果存在則準(zhǔn)備獲得字段數(shù)量

POP     EDX                     { forget instance, return Nil   } //否則恢復(fù)Edx  恢復(fù)實(shí)列 返回nil 當(dāng)前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                                                     //標(biāo)志位處理

JNE     @@notEqual                                                 //如果不等

DEC     ECX                     { ECX serves as counter         }  //字符長度減一

JNZ     @@cmpChar                                                  //如果還有沒有比較完的字符



{ found it }

MOV     EAX,[ESI]           { result is field offset plus ...   }  //獲得當(dāng)前的地址的偏移量

POP     EDX                                                        //恢復(fù)當(dāng)前實(shí)列到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;



































----------------------

一個(gè)實(shí)列的創(chuàng)建過程

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   

}