ITPub博客

首页 > Linux操作系统 > Linux操作系统 > delphi的Tobject类赏析

delphi的Tobject类赏析

原创 Linux操作系统 作者:luoyanqing119 时间:2009-06-10 09:10:49 0 删除 编辑
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   

}

来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/15678730/viewspace-605740/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论

注册时间:2009-04-09

  • 博文量
    23
  • 访问量
    32761