Delphi的对象机制浅探
Delphi的对象机制浅探
Delphi的对象机制浅探
[email protected]
2004-1-3
前几天开始阅读 VCL 源代码，可是几个基类的继承代码把我看得头大。在大富翁请教了几位仁兄后，我还是对Delphi对象的创建和方法调用原理不太清楚。最后只好临时啃了一下汇编，把Delphi对象操作的几个关键的方法勘察了一遍。
你可以通过以下链接知道我为什么要做这件事：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2385681
这是我花费一个晚上的测试结果，更多的细节只能以后在学习中再去了解。
主要测试项目为：
⊙ 测试目标：查看 TObject.Create 的编译器实现
⊙ 测试目标：查看 constructor 函数中 inherited 的编译器实现
⊙ 测试目标：以 object reference 和 class reference 调用构造函数的编译器实现
⊙ 测试目标：考查 Object 和 Class 在调用 class method 时的编译器实现
⊙ 测试目标：考查 ShortString 返回值类型的函数没有赋值时编译器的实现
我把测试的细节记录在后文，一是自己留作参考，二是给对此有兴趣的朋友参考。其实更重要的是，大家可以帮忙检查我的分析有没有错误。我一直是用 Delphi 的组件拖放编程，真正的功底只是这几天阅读 Object Pascal Reference 和 VCL 得来的，汇编更是临时抱佛脚，所以错误难免。我清楚自己的水平，所以写下结论后非常担心。尽管如此，我的目的是为了学习，希望你发现错误后帮我指出来。
主要的结论是：
(*) TObject.Create确实是个空函数，Borland 并没有隐藏 TObject.Create 的代码。TObject.Create的汇编代码是由 constructor directive 指示编译器形成的，编译器对每个class 都一视同仁。
(*) dl 和 eax 是 constructor Create 实现的关键寄存器。Borland 将对象的创建过程设计得精妙而清晰(个人感觉，因为我不知道其他的语言比如C++是如何实现的)。
(*) 一个对象的正常的创建(Obj := TMyClass.Create)过程是这样的：
1. 编译器保证第一个 constructor 调用之前 dl = 1
编译器保证 inherited Create 调用之前 dl = 0
2. dl = 1 时 编译器保证 Create 时 eax = pointer to class VMT
dl = 0 时 编译器保证 Create 时 eax = pointer to current object
3. 编译器保证任何层次的 constructor 调用后 eax = pointer to current object
4. dl = 1 时 编译器保证 Create 调用 System._ClassCreate，并与 constructor 相同的方式使用 eax
dl = 1 时 编译器保证 Create 调用 System._AfterConstruction，并且调用前后 eax = pointer to current object
dl = 0 时 编译器保证 Create 不会调用 System._ClassCreate
dl = 0 时 编译器保证 Create 不会调用 System._AfterConstruction
5. System._ClassCreate 中设置结构化异常处理，在 Create 即将结束时关闭结构化异常处理。
如果出错则会(1)释放由编译器分配的内存(2)恢复堆栈至创建对象之前(3)调用 TSomeClass.Destroy。
(*) object reference 方式的 constructor 调用，编译器尝试实现为 inherited 调用，结果当然是错误。
(*) class method 的调用隐含参数 eax 为指向 VMT 的指针，不管是用 class 还是 object 方式调用，编译器都会正确地把指向 class VMT 的指针传递给 eax。
要读懂下文的测试过程，可能需要相关基础，推荐阅读 Object Pascal Reference 以下章节：
Parameter passing
Function results
Calling conventions (register缺省调用约定，constructor 和 destructor 函数必须采用 register 约定)
Inline assambly code
《Delphi的原子世界》非常值得一读。
以下是测试内容：
=================================================
⊙ 测试目标：查看 TObject.Create 的编译器实现
=================================================
⊙ 测试代码及反汇编代码：
procedure Test; register;
var
Obj: TObject;
begin
push ebp ; 前2句用于设置堆栈指针
mov ebp, esp
push ecx ; 保存 ecx (无用的语句)
Obj := TObject.Create;
mov dl, $01 ; 设置 dl = 1，通知 TObject.Create 这是一次新建对象的调用
mov eax, [$004010a0] ; 把指向 TObject class VMT 的指针存入 eax，
; 作为 TObject.Create 隐含的 Self 参数
call TObject.Create ; 调用 TObject.Create 函数
mov [ebp-$04], eax ; TObject.Create 返回新建对象的指针至 Obj
end;
pop ecx ; 恢复堆栈并返回
pop ebp
ret
⊙ TObject.Create 的反汇编代码：
; 函数进入时 eax = pointer to VMT (dl = 1)
eax = pointer to instance (dl = 0)
; 函数返回时 eax = pointer to instance
test dl, dl ; 检查 dl 是否 = 0
jz +$08 ; dl = 0则跳至 @@1
add esp, -$10 ; 增加 16 字节的堆栈，每次调用 _ClassCreate 之前都会进行
; 用于 System._ClassCreate 设置结构化异常处理
call @ClassCreate ; 调用 System._ClassCreate
@@1:
test dl, dl ; 检查 dl 是否 = 0
jz +$0f ; dl = 0则跳到 end 结束过程
call @AfterConstruction ; dl <> 0 则调用 System._AfterConstruction
; (注意不是 TObject.AfterConstruction)
pop dword ptr fs:[$00000000] ; fs:[0] 指向结构化异常处理的函数，此即取消最后一次的 try..except设置
; 这个 try..except 在 System._ClassCreate 中创建
; 用于在出错时自动恢复堆栈/释放内存分配/并调用 TObject.Free
add esp, $0c ; 恢复堆栈，注意只恢复了 12 字节的堆栈，还有4字节由上句 pop 了
ret
注意：以上汇编代码中重复出现了 test dl,dl，说明 Borland 并没有特别对待 TObject.Create，TObject.Create确实是个空函数。TObject.Create的汇编代码是由 constructor directive 指示编译器形成的，编译器对每个class 都一视同仁。
注意：这段 TObject.Create 代码是在 PC 机上编译的结果，严格地说应该是在 Win32 操作系统上的实现之一。查看System._ClassCreate 就知道 Borland 还有其他的异常处理实现机制，产生的 TObject.Create 代码也不相同。
⊙ System._AfterContruction 函数的代码：
function _AfterConstruction(Instance: TObject): TObject;
begin
Instance.AfterConstruction;
Result := Instance;
end;
⊙ System._ClassCreate 函数的代码：
function _ClassCreate(AClass: TClass; Alloc: Boolean): TObject;
asm
{ -> EAX = pointer to VMT }
{ <- EAX = pointer to instance }
PUSH EDX ; 保存寄存器
PUSH ECX
PUSH EBX
TEST DL,DL ; 如果 dl = 0 则不调用 TObject.NewInstance
JL @@noAlloc
CALL DWORD PTR [EAX] + VMTOFFSET TObject.NewInstance ; 调用 TObject.NewInstance
@@noAlloc:
{$IFNDEF PC_MAPPED_EXCEPTIONS} ; 设置 PC 架构的结构化异常处理
XOR EDX,EDX
LEA ECX,[ESP+16]
MOV EBX,FS:[EDX]
MOV [ECX].TExcFrame.next,EBX
MOV [ECX].TExcFrame.hEBP,EBP
MOV [ECX].TExcFrame.desc,offset @desc
MOV [ECX].TexcFrame.ConstructedObject,EAX { trick: remember copy to instance }
MOV FS:[EDX],ECX
{$ENDIF}
POP EBX ; 恢复寄存器
POP ECX
POP EDX
RET
{$IFNDEF PC_MAPPED_EXCEPTIONS} ; 设置非 PC 架构的结构化异常处理
@desc:
JMP _HandleAnyException
{ destroy the object }
MOV EAX,[ESP+8+9*4]
MOV EAX,[EAX].TExcFrame.ConstructedObject
TEST EAX,EAX
JE @@skip
MOV ECX,[EAX]
MOV DL,$81
PUSH EAX
CALL DWORD PTR [ECX] + VMTOFFSET TObject.Destroy
POP EAX
CALL _ClassDestroy
@@skip:
{ reraise the exception }
CALL _RaiseAgain
{$ENDIF}
end;
==============================================================
⊙ 测试目标：查看 constructor 函数中 inherited 的编译器实现
==============================================================
⊙ 测试代码及反汇编代码：
type
TMyClass = class(TObject)
constructor Create;
end;
constructor TMyClass.Create;
begin
inherited; // 考查此句的实现
Beep;
end;
procedure Test; register;
var
Obj: TMyClass;
begin
Obj := TMyClass.Create;
mov dl, $01 ; class reference 时编译器设置 dl = 1
mov eax, [$004600ec] ; 设置 eax 为指向 TMyClass 的 VMT pointer
call TMyClass.Create ; 调用 TMyClass.Create
mov [ebp-$04], eax ; 保存 新建对象的指针
end;
constructor TMyClass.Create 的反汇编代码：
; 函数进入时 eax = pointer to VMT (dl = 1)
eax = pointer to instance (dl = 0)
; 函数返回时 eax = pointer to instance
begin
push ebp ; 这3句用于保存堆栈指针和创建堆栈
mov ebp, esp
add esp, -$08
test dl, dl ; 如果 dl = 0 则跳到 @ClassCreate 之后 @@1 处执行
jz +$08
add esp, -$10 ; 为 _ClassCreate 调用准备堆栈
call @ClassCreate ; 调用 System._ClassCreate，执行完成后 eax = 新建对象的指针
@@1:
mov [ebp-$05], dl ; 将 dl 值保存到堆栈中的 1 字节中，因为后面的 inherited TObject.Create
; 可能会改变 edx 的值
mov [ebp-$04], eax ; 保存 eax 到堆栈, eax = pointer to instance
inherited;
xor edx, edx ; 将 edx 清零(dl = 0)，以通知 TObject.Create 不用再调用
; _ClassCreate 和 AfterConstructor (编译器实现)
mov eax, [ebp-$04] ; 将 eax 的值还原为前面保存在堆栈的 eax 值
; (这句是多余的，但在其它情况下可能必须执行此句)
call TObject.Create ; 调用 TObject.Create
Beep;
call Beep ; 继承类中 inherited 之后实现的功能
mov eax, [ebp-$04] ; 将 eax 的值还原为前面保存在堆栈的 eax 值
cmp byte ptr [ebp-$05], $00 ; (间接)检查 dl 是否 = 0
jz +$0f ; dl = 0 则跳过 _AfterConstruction 到 @@2 处
call @AfterConstruction ; 调用 System._AfterConstruction
pop dword ptr fs:[$00000000] ; 这2句恢复为 _ClassCreate 创建的堆栈空间
add esp, $0c
@@2:
mov eax, [ebp-$04] ; 返回 pointer to instance
end;
pop ecx
pop ecx
pop ebp
ret
结论：真是精妙！一个对象的正常的创建(Obj := TMyObj.Create, 与后面不正常的调用相对)过程是这样的：
1. 编译器保证第一个 constructor 调用之前 dl = 1
编译器保证 inherited Create 调用之前 dl = 0
2. dl = 1 时 编译器保证 Create 时 eax = pointer to class VMT
dl = 0 时 编译器保证 Create 时 eax = pointer to current object
3. 编译器保证任何层次的 constructor 调用后 eax = pointer to current object
4. dl = 1 时 编译器保证 Create 调用 System._ClassCreate，并与 constructor 相同的方式使用 eax
dl = 1 时 编译器保证 Create 调用 System._AfterConstruction，并且调用前后 eax = pointer to current object
dl = 0 时 编译器保证 Create 不会调用 System._ClassCreate
dl = 0 时 编译器保证 Create 不会调用 System._AfterConstruction
5. System._ClassCreate 中设置结构化异常处理，在 Create 即将结束时关闭结构化异常处理。
如果出错则会(1)释放由编译器分配的内存(2)恢复堆栈至创建对象之前(3)调用 TSomeClass.Destroy。
看上去有点繁杂，可是如果读懂了上面 TObject.Create 和 TMyObject.Create 则会感觉对象的创建非常清晰。
==================================================================================
⊙ 测试目标：以 object reference 和 class reference 调用构造函数的编译器实现
==================================================================================
⊙ static constructor 测试代码及反汇编代码 (省略了begin 和 end 后面的堆栈分配代码)：
procedure Test; register;
var
Obj: TObject;
begin
Obj := TObject.Create;
mov dl, $01 ; 采用 class reference 时编译器自动设置 dl = 1
mov eax, [$004010a0] ; 把指向 TObject class VMT 的指针存入 eax，用于下一行调用
call TObject.Create
mov [ebp-$04], eax
Obj := Obj.Create;
or edx, -$01 ; 采用 object reference 时编译器自动设置 edx 的所有 bit 都为 1
mov eax, [ebp-$04] ; 把 Obj 指针的所指的区域(即对象内存空间)存入 eax，用于下一行调用
call TObject.Create
mov [ebp-$04], eax
end;
⊙ virtual constructor测试代码及反汇编代码 (省略了begin 和 end 后面的堆栈分配代码)：
procedure Test; register;
var
Comp: TComponent;
begin
Comp := TComponent.Create(nil);
xor ecx, ecx ; 设置 参数 = nil
mov dl, $01 ; 设置 dl = 1
mov eax, [$00412eac] ; 设置 eax = class VMT pointer
call TComponent.Create ; 调用 TComponent.Create
mov [ebp-$04], eax ; 保存 新建的对象至 Comp
Comp := Comp.Create(nil);
xor ecx, ecx ; 同上
or edx, -$01 ; 设置 edx 所有位为 1
mov eax, [ebp-$04] ; 这句和下句 设置 ebx 为 TComponent class 的 VMT pointer
mov ebx, [eax] ; (如果 Comp 已经实例化了，则 ebx 的值是对的)
call dword ptr [ebx+$2c] ; 可能是调用 TComponent.Create(Comp, -1, nil);
mov [ebp-$04], eax ; 保存 新建的对象至 Comp
end;
结论：object reference 方式的 constructor 调用，编译器尝试实现为 inherited 调用，结果当然是错误。
=======================================================================
⊙ 测试目标：考查 Object 和 Class 在调用 class method 时的编译器实现
=======================================================================
⊙ 测试代码及反汇编代码 (省略了begin 和 end 后面的堆栈分配代码)：
procedure Test; register;
var
Com: TComponent;
Str: String[255];
begin
Com := TComponent.Create(nil);
xor ecx, ecx
mov dl, $01
mov eax, [$00412eac] ; eax = pointer to class VMT
call TComponent.Create
mov [ebp-$04], eax
Str := Com.ClassName;
lea edx, [ebp-$00000104]
mov eax, [ebp-$04] ; eax = pointer to object
mov eax, [eax] ; eax = pointer to VMT
call TObject.ClassName
Str := TComponent.ClassName;
lea edx, [ebp-$00000104] ; edx = address of Str
; ShortString 类型的返回值是以 var 类型的参数传递的
mov eax, [$00412eac] ; eax = pointer to class VMT
call TObject.ClassName
end;
结论：class method 的调用隐含参数 eax 为指向 VMT 的指针，不管是用 class 还是 object 方式调用，编译器都会正确地把指向 class VMT 的指针传递给 eax。
========================================================================
⊙ 测试目标：考查 ShortString 返回值类型的函数没有赋值时编译器的实现
========================================================================
procedure Test; register;
begin
TComponent.ClassName;
lea edx, [ebp-$00000100] ; 编译器会在堆栈中创建256 byte 的临时空间，以保证 edx 不会为非法值
mov eax, [$00412eac]
call TObject.ClassName
end;
⊙ TObject.ClassName 函数代码：
class function TObject.ClassName: ShortString;
{$IFDEF PUREPASCAL}
begin
Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;
end;
{$ELSE}
asm
{ -> EAX VMT }
{ EDX Pointer to result string }
PUSH ESI
PUSH EDI
MOV EDI,EDX ; EDX 是返回值串的指针
MOV ESI,[EAX].vmtClassName
XOR ECX,ECX
MOV CL,[ESI] ; 设置 result string 的 length
INC ECX
REP MOVSB
POP EDI
POP ESI
end;
{$ENDIF}
结论：这只是我想了解字符串返回值的传递方式。
===================
(完)
===================
[email protected]
2004-1-3
前几天开始阅读 VCL 源代码，可是几个基类的继承代码把我看得头大。在大富翁请教了几位仁兄后，我还是对Delphi对象的创建和方法调用原理不太清楚。最后只好临时啃了一下汇编，把Delphi对象操作的几个关键的方法勘察了一遍。
你可以通过以下链接知道我为什么要做这件事：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2385681
这是我花费一个晚上的测试结果，更多的细节只能以后在学习中再去了解。
主要测试项目为：
⊙ 测试目标：查看 TObject.Create 的编译器实现
⊙ 测试目标：查看 constructor 函数中 inherited 的编译器实现
⊙ 测试目标：以 object reference 和 class reference 调用构造函数的编译器实现
⊙ 测试目标：考查 Object 和 Class 在调用 class method 时的编译器实现
⊙ 测试目标：考查 ShortString 返回值类型的函数没有赋值时编译器的实现
我把测试的细节记录在后文，一是自己留作参考，二是给对此有兴趣的朋友参考。其实更重要的是，大家可以帮忙检查我的分析有没有错误。我一直是用 Delphi 的组件拖放编程，真正的功底只是这几天阅读 Object Pascal Reference 和 VCL 得来的，汇编更是临时抱佛脚，所以错误难免。我清楚自己的水平，所以写下结论后非常担心。尽管如此，我的目的是为了学习，希望你发现错误后帮我指出来。
主要的结论是：
(*) TObject.Create确实是个空函数，Borland 并没有隐藏 TObject.Create 的代码。TObject.Create的汇编代码是由 constructor directive 指示编译器形成的，编译器对每个class 都一视同仁。
(*) dl 和 eax 是 constructor Create 实现的关键寄存器。Borland 将对象的创建过程设计得精妙而清晰(个人感觉，因为我不知道其他的语言比如C++是如何实现的)。
(*) 一个对象的正常的创建(Obj := TMyClass.Create)过程是这样的：
1. 编译器保证第一个 constructor 调用之前 dl = 1
编译器保证 inherited Create 调用之前 dl = 0
2. dl = 1 时 编译器保证 Create 时 eax = pointer to class VMT
dl = 0 时 编译器保证 Create 时 eax = pointer to current object
3. 编译器保证任何层次的 constructor 调用后 eax = pointer to current object
4. dl = 1 时 编译器保证 Create 调用 System._ClassCreate，并与 constructor 相同的方式使用 eax
dl = 1 时 编译器保证 Create 调用 System._AfterConstruction，并且调用前后 eax = pointer to current object
dl = 0 时 编译器保证 Create 不会调用 System._ClassCreate
dl = 0 时 编译器保证 Create 不会调用 System._AfterConstruction
5. System._ClassCreate 中设置结构化异常处理，在 Create 即将结束时关闭结构化异常处理。
如果出错则会(1)释放由编译器分配的内存(2)恢复堆栈至创建对象之前(3)调用 TSomeClass.Destroy。
(*) object reference 方式的 constructor 调用，编译器尝试实现为 inherited 调用，结果当然是错误。
(*) class method 的调用隐含参数 eax 为指向 VMT 的指针，不管是用 class 还是 object 方式调用，编译器都会正确地把指向 class VMT 的指针传递给 eax。
要读懂下文的测试过程，可能需要相关基础，推荐阅读 Object Pascal Reference 以下章节：
Parameter passing
Function results
Calling conventions (register缺省调用约定，constructor 和 destructor 函数必须采用 register 约定)
Inline assambly code
《Delphi的原子世界》非常值得一读。
以下是测试内容：
=================================================
⊙ 测试目标：查看 TObject.Create 的编译器实现
=================================================
⊙ 测试代码及反汇编代码：
procedure Test; register;
var
Obj: TObject;
begin
push ebp ; 前2句用于设置堆栈指针
mov ebp, esp
push ecx ; 保存 ecx (无用的语句)
Obj := TObject.Create;
mov dl, $01 ; 设置 dl = 1，通知 TObject.Create 这是一次新建对象的调用
mov eax, [$004010a0] ; 把指向 TObject class VMT 的指针存入 eax，
; 作为 TObject.Create 隐含的 Self 参数
call TObject.Create ; 调用 TObject.Create 函数
mov [ebp-$04], eax ; TObject.Create 返回新建对象的指针至 Obj
end;
pop ecx ; 恢复堆栈并返回
pop ebp
ret
⊙ TObject.Create 的反汇编代码：
; 函数进入时 eax = pointer to VMT (dl = 1)
eax = pointer to instance (dl = 0)
; 函数返回时 eax = pointer to instance
test dl, dl ; 检查 dl 是否 = 0
jz +$08 ; dl = 0则跳至 @@1
add esp, -$10 ; 增加 16 字节的堆栈，每次调用 _ClassCreate 之前都会进行
; 用于 System._ClassCreate 设置结构化异常处理
call @ClassCreate ; 调用 System._ClassCreate
@@1:
test dl, dl ; 检查 dl 是否 = 0
jz +$0f ; dl = 0则跳到 end 结束过程
call @AfterConstruction ; dl <> 0 则调用 System._AfterConstruction
; (注意不是 TObject.AfterConstruction)
pop dword ptr fs:[$00000000] ; fs:[0] 指向结构化异常处理的函数，此即取消最后一次的 try..except设置
; 这个 try..except 在 System._ClassCreate 中创建
; 用于在出错时自动恢复堆栈/释放内存分配/并调用 TObject.Free
add esp, $0c ; 恢复堆栈，注意只恢复了 12 字节的堆栈，还有4字节由上句 pop 了
ret
注意：以上汇编代码中重复出现了 test dl,dl，说明 Borland 并没有特别对待 TObject.Create，TObject.Create确实是个空函数。TObject.Create的汇编代码是由 constructor directive 指示编译器形成的，编译器对每个class 都一视同仁。
注意：这段 TObject.Create 代码是在 PC 机上编译的结果，严格地说应该是在 Win32 操作系统上的实现之一。查看System._ClassCreate 就知道 Borland 还有其他的异常处理实现机制，产生的 TObject.Create 代码也不相同。
⊙ System._AfterContruction 函数的代码：
function _AfterConstruction(Instance: TObject): TObject;
begin
Instance.AfterConstruction;
Result := Instance;
end;
⊙ System._ClassCreate 函数的代码：
function _ClassCreate(AClass: TClass; Alloc: Boolean): TObject;
asm
{ -> EAX = pointer to VMT }
{ <- EAX = pointer to instance }
PUSH EDX ; 保存寄存器
PUSH ECX
PUSH EBX
TEST DL,DL ; 如果 dl = 0 则不调用 TObject.NewInstance
JL @@noAlloc
CALL DWORD PTR [EAX] + VMTOFFSET TObject.NewInstance ; 调用 TObject.NewInstance
@@noAlloc:
{$IFNDEF PC_MAPPED_EXCEPTIONS} ; 设置 PC 架构的结构化异常处理
XOR EDX,EDX
LEA ECX,[ESP+16]
MOV EBX,FS:[EDX]
MOV [ECX].TExcFrame.next,EBX
MOV [ECX].TExcFrame.hEBP,EBP
MOV [ECX].TExcFrame.desc,offset @desc
MOV [ECX].TexcFrame.ConstructedObject,EAX { trick: remember copy to instance }
MOV FS:[EDX],ECX
{$ENDIF}
POP EBX ; 恢复寄存器
POP ECX
POP EDX
RET
{$IFNDEF PC_MAPPED_EXCEPTIONS} ; 设置非 PC 架构的结构化异常处理
@desc:
JMP _HandleAnyException
{ destroy the object }
MOV EAX,[ESP+8+9*4]
MOV EAX,[EAX].TExcFrame.ConstructedObject
TEST EAX,EAX
JE @@skip
MOV ECX,[EAX]
MOV DL,$81
PUSH EAX
CALL DWORD PTR [ECX] + VMTOFFSET TObject.Destroy
POP EAX
CALL _ClassDestroy
@@skip:
{ reraise the exception }
CALL _RaiseAgain
{$ENDIF}
end;
==============================================================
⊙ 测试目标：查看 constructor 函数中 inherited 的编译器实现
==============================================================
⊙ 测试代码及反汇编代码：
type
TMyClass = class(TObject)
constructor Create;
end;
constructor TMyClass.Create;
begin
inherited; // 考查此句的实现
Beep;
end;
procedure Test; register;
var
Obj: TMyClass;
begin
Obj := TMyClass.Create;
mov dl, $01 ; class reference 时编译器设置 dl = 1
mov eax, [$004600ec] ; 设置 eax 为指向 TMyClass 的 VMT pointer
call TMyClass.Create ; 调用 TMyClass.Create
mov [ebp-$04], eax ; 保存 新建对象的指针
end;
constructor TMyClass.Create 的反汇编代码：
; 函数进入时 eax = pointer to VMT (dl = 1)
eax = pointer to instance (dl = 0)
; 函数返回时 eax = pointer to instance
begin
push ebp ; 这3句用于保存堆栈指针和创建堆栈
mov ebp, esp
add esp, -$08
test dl, dl ; 如果 dl = 0 则跳到 @ClassCreate 之后 @@1 处执行
jz +$08
add esp, -$10 ; 为 _ClassCreate 调用准备堆栈
call @ClassCreate ; 调用 System._ClassCreate，执行完成后 eax = 新建对象的指针
@@1:
mov [ebp-$05], dl ; 将 dl 值保存到堆栈中的 1 字节中，因为后面的 inherited TObject.Create
; 可能会改变 edx 的值
mov [ebp-$04], eax ; 保存 eax 到堆栈, eax = pointer to instance
inherited;
xor edx, edx ; 将 edx 清零(dl = 0)，以通知 TObject.Create 不用再调用
; _ClassCreate 和 AfterConstructor (编译器实现)
mov eax, [ebp-$04] ; 将 eax 的值还原为前面保存在堆栈的 eax 值
; (这句是多余的，但在其它情况下可能必须执行此句)
call TObject.Create ; 调用 TObject.Create
Beep;
call Beep ; 继承类中 inherited 之后实现的功能
mov eax, [ebp-$04] ; 将 eax 的值还原为前面保存在堆栈的 eax 值
cmp byte ptr [ebp-$05], $00 ; (间接)检查 dl 是否 = 0
jz +$0f ; dl = 0 则跳过 _AfterConstruction 到 @@2 处
call @AfterConstruction ; 调用 System._AfterConstruction
pop dword ptr fs:[$00000000] ; 这2句恢复为 _ClassCreate 创建的堆栈空间
add esp, $0c
@@2:
mov eax, [ebp-$04] ; 返回 pointer to instance
end;
pop ecx
pop ecx
pop ebp
ret
结论：真是精妙！一个对象的正常的创建(Obj := TMyObj.Create, 与后面不正常的调用相对)过程是这样的：
1. 编译器保证第一个 constructor 调用之前 dl = 1
编译器保证 inherited Create 调用之前 dl = 0
2. dl = 1 时 编译器保证 Create 时 eax = pointer to class VMT
dl = 0 时 编译器保证 Create 时 eax = pointer to current object
3. 编译器保证任何层次的 constructor 调用后 eax = pointer to current object
4. dl = 1 时 编译器保证 Create 调用 System._ClassCreate，并与 constructor 相同的方式使用 eax
dl = 1 时 编译器保证 Create 调用 System._AfterConstruction，并且调用前后 eax = pointer to current object
dl = 0 时 编译器保证 Create 不会调用 System._ClassCreate
dl = 0 时 编译器保证 Create 不会调用 System._AfterConstruction
5. System._ClassCreate 中设置结构化异常处理，在 Create 即将结束时关闭结构化异常处理。
如果出错则会(1)释放由编译器分配的内存(2)恢复堆栈至创建对象之前(3)调用 TSomeClass.Destroy。
看上去有点繁杂，可是如果读懂了上面 TObject.Create 和 TMyObject.Create 则会感觉对象的创建非常清晰。
==================================================================================
⊙ 测试目标：以 object reference 和 class reference 调用构造函数的编译器实现
==================================================================================
⊙ static constructor 测试代码及反汇编代码 (省略了begin 和 end 后面的堆栈分配代码)：
procedure Test; register;
var
Obj: TObject;
begin
Obj := TObject.Create;
mov dl, $01 ; 采用 class reference 时编译器自动设置 dl = 1
mov eax, [$004010a0] ; 把指向 TObject class VMT 的指针存入 eax，用于下一行调用
call TObject.Create
mov [ebp-$04], eax
Obj := Obj.Create;
or edx, -$01 ; 采用 object reference 时编译器自动设置 edx 的所有 bit 都为 1
mov eax, [ebp-$04] ; 把 Obj 指针的所指的区域(即对象内存空间)存入 eax，用于下一行调用
call TObject.Create
mov [ebp-$04], eax
end;
⊙ virtual constructor测试代码及反汇编代码 (省略了begin 和 end 后面的堆栈分配代码)：
procedure Test; register;
var
Comp: TComponent;
begin
Comp := TComponent.Create(nil);
xor ecx, ecx ; 设置 参数 = nil
mov dl, $01 ; 设置 dl = 1
mov eax, [$00412eac] ; 设置 eax = class VMT pointer
call TComponent.Create ; 调用 TComponent.Create
mov [ebp-$04], eax ; 保存 新建的对象至 Comp
Comp := Comp.Create(nil);
xor ecx, ecx ; 同上
or edx, -$01 ; 设置 edx 所有位为 1
mov eax, [ebp-$04] ; 这句和下句 设置 ebx 为 TComponent class 的 VMT pointer
mov ebx, [eax] ; (如果 Comp 已经实例化了，则 ebx 的值是对的)
call dword ptr [ebx+$2c] ; 可能是调用 TComponent.Create(Comp, -1, nil);
mov [ebp-$04], eax ; 保存 新建的对象至 Comp
end;
结论：object reference 方式的 constructor 调用，编译器尝试实现为 inherited 调用，结果当然是错误。
=======================================================================
⊙ 测试目标：考查 Object 和 Class 在调用 class method 时的编译器实现
=======================================================================
⊙ 测试代码及反汇编代码 (省略了begin 和 end 后面的堆栈分配代码)：
procedure Test; register;
var
Com: TComponent;
Str: String[255];
begin
Com := TComponent.Create(nil);
xor ecx, ecx
mov dl, $01
mov eax, [$00412eac] ; eax = pointer to class VMT
call TComponent.Create
mov [ebp-$04], eax
Str := Com.ClassName;
lea edx, [ebp-$00000104]
mov eax, [ebp-$04] ; eax = pointer to object
mov eax, [eax] ; eax = pointer to VMT
call TObject.ClassName
Str := TComponent.ClassName;
lea edx, [ebp-$00000104] ; edx = address of Str
; ShortString 类型的返回值是以 var 类型的参数传递的
mov eax, [$00412eac] ; eax = pointer to class VMT
call TObject.ClassName
end;
结论：class method 的调用隐含参数 eax 为指向 VMT 的指针，不管是用 class 还是 object 方式调用，编译器都会正确地把指向 class VMT 的指针传递给 eax。
========================================================================
⊙ 测试目标：考查 ShortString 返回值类型的函数没有赋值时编译器的实现
========================================================================
procedure Test; register;
begin
TComponent.ClassName;
lea edx, [ebp-$00000100] ; 编译器会在堆栈中创建256 byte 的临时空间，以保证 edx 不会为非法值
mov eax, [$00412eac]
call TObject.ClassName
end;
⊙ TObject.ClassName 函数代码：
class function TObject.ClassName: ShortString;
{$IFDEF PUREPASCAL}
begin
Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;
end;
{$ELSE}
asm
{ -> EAX VMT }
{ EDX Pointer to result string }
PUSH ESI
PUSH EDI
MOV EDI,EDX ; EDX 是返回值串的指针
MOV ESI,[EAX].vmtClassName
XOR ECX,ECX
MOV CL,[ESI] ; 设置 result string 的 length
INC ECX
REP MOVSB
POP EDI
POP ESI
end;
{$ENDIF}
结论：这只是我想了解字符串返回值的传递方式。
===================
(完)
===================
来自： lance2000,
时间：2004-1-3 9:46:00,
ID：2390276
写的非常好！
来自： dedema,
时间：2004-1-3 9:57:00,
ID：2390302
这么厉害啊！一个晚上就完成了！
来自： 积步,
时间：2004-1-3 10:10:00,
ID：2390324
mark
来自： zhumoo,
时间：2004-1-3 10:26:00,
ID：2390353
高手就是高手,学习.
来自： kk2000,
时间：2004-1-3 15:05:00,
ID：2390894
楼主一个晚上完成，只能说佩服了！
来自： renyi,
时间：2004-1-3 17:54:00,
ID：2391175
厉害，不知 Delphi 的对象机制和 Java 、C# 相比，哪个个的效率更高？
来自： einsteingod,
时间：2004-1-3 19:07:00,
ID：2391225
写的非常好！
来自： xff916,
时间：2004-1-3 19:49:00,
ID：2391246
牛呀，学习 ，学习，在学习
来自： 积步,
时间：2004-1-3 19:50:00,
ID：2391248
小弟還有一事不知。
通過asm訪問類 的私有變量.
TA = class
private
FA: Integer;
public
procedure SetA(Value: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV ECX, A.FA; //為什麼A.FA => 100 立即數就可以顯示為 100, 如果不改就顯示為其它值。
MOV tmpInt, ECX;
end;
ShowMessage(IntToStr(tmpInt));
A.Free;
end;
通過asm訪問類 的私有變量.
TA = class
private
FA: Integer;
public
procedure SetA(Value: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV ECX, A.FA; //為什麼A.FA => 100 立即數就可以顯示為 100, 如果不改就顯示為其它值。
MOV tmpInt, ECX;
end;
ShowMessage(IntToStr(tmpInt));
A.Free;
end;
来自： savetime,
时间：2004-1-4 1:30:00,
ID：2391511
to 积步:
DELPHI 对“MOV ECX, A.FA”生成的代码实际上是以 Record 的类型生成的，这样 ECX 的值就是
变量 A 的地址 加上 TA.FA 的偏移值，结果是 ECX 变成堆栈上的一个值，所以不对。
A.FA 的实际地址是 A 指向的地址(也就是对象内存位置，而不是 A 的地址)加上 FA 相对于对象
头部的偏移地址。我凑出以下的代码，可以实现你要的结果：
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV EBX, A
MOV ECX, TA(EBX).FA; // 通知编译器 EBX 指向的是 TA class
MOV tmpInt, ECX;
end;
ShowMessage(IntToStr(tmpInt));
A.Free;
end;
我没写过汇编代码，所以不知道 DELPHI 会不会自动保护其他使用 EBX 的语句。如果你知道在混合
汇编的情况下如何使用寄存器请教我一下。
其实我真的不知道还有这种方法可以获得私有成员，有趣！
DELPHI 对“MOV ECX, A.FA”生成的代码实际上是以 Record 的类型生成的，这样 ECX 的值就是
变量 A 的地址 加上 TA.FA 的偏移值，结果是 ECX 变成堆栈上的一个值，所以不对。
A.FA 的实际地址是 A 指向的地址(也就是对象内存位置，而不是 A 的地址)加上 FA 相对于对象
头部的偏移地址。我凑出以下的代码，可以实现你要的结果：
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV EBX, A
MOV ECX, TA(EBX).FA; // 通知编译器 EBX 指向的是 TA class
MOV tmpInt, ECX;
end;
ShowMessage(IntToStr(tmpInt));
A.Free;
end;
我没写过汇编代码，所以不知道 DELPHI 会不会自动保护其他使用 EBX 的语句。如果你知道在混合
汇编的情况下如何使用寄存器请教我一下。
其实我真的不知道还有这种方法可以获得私有成员，有趣！
来自： savetime,
时间：2004-1-4 2:40:00,
ID：2391532
内容更正：
我发现自己在上文注释中的一个错误，在以下汇编第三行的“ push ecx ”我把它注释为
“保存 ecx (无用的语句)”，
更正为：
“分配局部变量 Obj 的堆栈空间”。
原来 add esp, -$4 花费 3 个字节的指令
而 push ecx 只要 1 个字节的指令，执行更快
大家现在知道我不是高手了吧，我是一边翻汇编手册，一边写注释的。我只能毫不谦虚地
说：我真的是初学者。高手看这些简单的汇编代码哪里需要花一个晚上。
希望大家关注内容，不要只是说“好”，重要的是“有没有错误”，这样才能提高。
出错的注释段：
=================================================
⊙ 测试目标：查看 TObject.Create 的编译器实现
=================================================
⊙ 测试代码及反汇编代码：
procedure Test; register;
var
Obj: TObject;
begin
push ebp ; 前2句用于设置堆栈指针
mov ebp, esp
push ecx ; 保存 ecx (无用的语句) -> (更正为) 分配局部变量 Obj 的堆栈空间
Obj := TObject.Create;
mov dl, $01 ; 设置 dl = 1，通知 TObject.Create 这是一次新建对象的调用
mov eax, [$004010a0] ; 把指向 TObject class VMT 的指针存入 eax，
; 作为 TObject.Create 隐含的 Self 参数
call TObject.Create ; 调用 TObject.Create 函数
mov [ebp-$04], eax ; TObject.Create 返回新建对象的指针至 Obj
end;
pop ecx ; 恢复堆栈并返回
pop ebp
ret
我发现自己在上文注释中的一个错误，在以下汇编第三行的“ push ecx ”我把它注释为
“保存 ecx (无用的语句)”，
更正为：
“分配局部变量 Obj 的堆栈空间”。
原来 add esp, -$4 花费 3 个字节的指令
而 push ecx 只要 1 个字节的指令，执行更快
大家现在知道我不是高手了吧，我是一边翻汇编手册，一边写注释的。我只能毫不谦虚地
说：我真的是初学者。高手看这些简单的汇编代码哪里需要花一个晚上。
希望大家关注内容，不要只是说“好”，重要的是“有没有错误”，这样才能提高。
出错的注释段：
=================================================
⊙ 测试目标：查看 TObject.Create 的编译器实现
=================================================
⊙ 测试代码及反汇编代码：
procedure Test; register;
var
Obj: TObject;
begin
push ebp ; 前2句用于设置堆栈指针
mov ebp, esp
push ecx ; 保存 ecx (无用的语句) -> (更正为) 分配局部变量 Obj 的堆栈空间
Obj := TObject.Create;
mov dl, $01 ; 设置 dl = 1，通知 TObject.Create 这是一次新建对象的调用
mov eax, [$004010a0] ; 把指向 TObject class VMT 的指针存入 eax，
; 作为 TObject.Create 隐含的 Self 参数
call TObject.Create ; 调用 TObject.Create 函数
mov [ebp-$04], eax ; TObject.Create 返回新建对象的指针至 Obj
end;
pop ecx ; 恢复堆栈并返回
pop ebp
ret
来自： savetime,
时间：2004-1-4 2:40:00,
ID：2391533
to 积步,
我测试了在混合汇编的情况下修改寄存器时的实现，结果是：Delphi 会自动把嵌入汇编中修改了的寄存器备份在堆
栈中，所以可以随意使用 Delphi 允许的寄存器。
我测试了在混合汇编的情况下修改寄存器时的实现，结果是：Delphi 会自动把嵌入汇编中修改了的寄存器备份在堆
栈中，所以可以随意使用 Delphi 允许的寄存器。
来自： book523,
时间：2004-1-4 10:20:00,
ID：2391614
结论：真是精妙！一个对象的正常的创建(Obj := TMyObj.Create, 与后面不正常的调用相对)过程是这样的：
1. 编译器保证第一个 constructor 调用之前 dl = 1
编译器保证 inherited Create 调用之前 dl = 0
2. dl = 1 时 编译器保证 Create 时 eax = pointer to class VMT
dl = 0 时 编译器保证 Create 时 eax = pointer to current object
3. 编译器保证任何层次的 constructor 调用后 eax = pointer to current object
4. dl = 1 时 编译器保证 Create 调用 System._ClassCreate，并与 constructor 相同的方式使用 eax
dl = 1 时 编译器保证 Create 调用 System._AfterConstruction，并且调用前后 eax = pointer to current object
dl = 0 时 编译器保证 Create 不会调用 System._ClassCreate
dl = 0 时 编译器保证 Create 不会调用 System._AfterConstruction
5. System._ClassCreate 中设置结构化异常处理，在 Create 即将结束时关闭结构化异常处理。
如果出错则会(1)释放由编译器分配的内存(2)恢复堆栈至创建对象之前(3)调用 TSomeClass.Destroy。
看上去有点繁杂，可是如果读懂了上面 TObject.Create 和 TMyObject.Create 则会感觉对象的创建非常清晰。
-------------------------------------------------------------------------------
为什么要保存经常调用dl的值？
Dl主要用来表示是class级别调用还是对象级别调用，
class级别调用时，constructor会自动执行
System._ClassCreate，NewInstance,InitInstance，AfterConstruction等过程，
然后才是Constructor中的代码，
而对象级别调用时，只会执行Constructor中的代码。
1. 编译器保证第一个 constructor 调用之前 dl = 1
编译器保证 inherited Create 调用之前 dl = 0
2. dl = 1 时 编译器保证 Create 时 eax = pointer to class VMT
dl = 0 时 编译器保证 Create 时 eax = pointer to current object
3. 编译器保证任何层次的 constructor 调用后 eax = pointer to current object
4. dl = 1 时 编译器保证 Create 调用 System._ClassCreate，并与 constructor 相同的方式使用 eax
dl = 1 时 编译器保证 Create 调用 System._AfterConstruction，并且调用前后 eax = pointer to current object
dl = 0 时 编译器保证 Create 不会调用 System._ClassCreate
dl = 0 时 编译器保证 Create 不会调用 System._AfterConstruction
5. System._ClassCreate 中设置结构化异常处理，在 Create 即将结束时关闭结构化异常处理。
如果出错则会(1)释放由编译器分配的内存(2)恢复堆栈至创建对象之前(3)调用 TSomeClass.Destroy。
看上去有点繁杂，可是如果读懂了上面 TObject.Create 和 TMyObject.Create 则会感觉对象的创建非常清晰。
-------------------------------------------------------------------------------
为什么要保存经常调用dl的值？
Dl主要用来表示是class级别调用还是对象级别调用，
class级别调用时，constructor会自动执行
System._ClassCreate，NewInstance,InitInstance，AfterConstruction等过程，
然后才是Constructor中的代码，
而对象级别调用时，只会执行Constructor中的代码。
来自： savetime,
时间：2004-1-4 12:18:00,
ID：2391785
to book523,
你说的是我在“⊙测试目标：以 object reference 和 class reference 调用构造函数的编译器实现”中的结果吧。我在文章中写的结论是：“object reference 方式的 constructor 调用，编译器尝试实现为 inherited 调用”
其实如果你看了测试代码的反汇编过程，就应该知道我的这个结论是错误的。Borland 在 Object Pascal Reference 中写的就是你说的“对象级别调用时，只会执行Constructor中的代码。”，可是事实上不是这样。
在形式如下的代码中
AComp := AComp.Create
Borland 先将 edx 所有 bit 设置为 1 ，也就是 dl 为 1，也就是仍然尝试沿用 class 级别的调用。可是你看 Delphi 的生成的汇编代码不知所云，所以根本就没有所谓的“对象级别调用”。我认为 Borland 应该对 AComp := AComp.Create 调用提示为语法错误。我实在是想不到什么时候会需要这种形式的调用。
我测试这样的调用方式是因为我经常在创建 Form 时忘了写 T 这一标识符：
ChildForm := ChildForm.Create(nil); // 这里应该是 TChildForm.Create(nil)
我想知道这样的结果是什么。
你说的是我在“⊙测试目标：以 object reference 和 class reference 调用构造函数的编译器实现”中的结果吧。我在文章中写的结论是：“object reference 方式的 constructor 调用，编译器尝试实现为 inherited 调用”
其实如果你看了测试代码的反汇编过程，就应该知道我的这个结论是错误的。Borland 在 Object Pascal Reference 中写的就是你说的“对象级别调用时，只会执行Constructor中的代码。”，可是事实上不是这样。
在形式如下的代码中
AComp := AComp.Create
Borland 先将 edx 所有 bit 设置为 1 ，也就是 dl 为 1，也就是仍然尝试沿用 class 级别的调用。可是你看 Delphi 的生成的汇编代码不知所云，所以根本就没有所谓的“对象级别调用”。我认为 Borland 应该对 AComp := AComp.Create 调用提示为语法错误。我实在是想不到什么时候会需要这种形式的调用。
我测试这样的调用方式是因为我经常在创建 Form 时忘了写 T 这一标识符：
ChildForm := ChildForm.Create(nil); // 这里应该是 TChildForm.Create(nil)
我想知道这样的结果是什么。
来自： vc_delphi,
时间：2004-1-4 18:27:00,
ID：2392395
高手就是高手,学习.
来自： 积步,
时间：2004-1-4 21:30:00,
ID：2392563
to savetime:
多謝指教。
以前也研究過匯編什麼東東的， 但是現在沒有多少時間研究。
多謝指教。
以前也研究過匯編什麼東東的， 但是現在沒有多少時間研究。
来自： 积步,
时间：2004-1-4 21:35:00,
ID：2392623
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV EAX, A;
MOV EAX, [EAX + 4];
//這樣也行 MOV EAX, [EAX] + 4 都是得到當前對象的第一變量
//MOV EAX, [EAX] + 8 訪問第二個變量， 依此類推
//MOV EAX, [EAX], 是指向VMT的指針
MOV tmpInt, EAX;
end;
ShowMessage(IntToStr(tmpInt));
A.Free;
end;
這樣也可以實現， 但是想不到savetime兄弟還有更高的招術， 厲害厲害!!
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV EAX, A;
MOV EAX, [EAX + 4];
//這樣也行 MOV EAX, [EAX] + 4 都是得到當前對象的第一變量
//MOV EAX, [EAX] + 8 訪問第二個變量， 依此類推
//MOV EAX, [EAX], 是指向VMT的指針
MOV tmpInt, EAX;
end;
ShowMessage(IntToStr(tmpInt));
A.Free;
end;
這樣也可以實現， 但是想不到savetime兄弟還有更高的招術， 厲害厲害!!
来自： xchen.d,
时间：2004-1-4 21:33:00,
ID：2392650
我看‘中国有救了‘，真有耐力！呵呵
心不静，做不了
心不静，做不了
来自： savetime,
时间：2004-1-5 10:15:00,
ID：2392767
to 积步,
我又从你这里学到一点汇编知识，知识就是这样积累出来的呀。
to everybody,
其实要看懂文中的汇编并不难，我做的这件工作只是 Delphi 的基础而已。读懂和会用根本上是两回事。
我现在正在分析 TWinControl 如何如何封装 Windows 的消息系统，二天过去，进展不大。相关的函数太多了，还有一些汇编夹在其中。我认为消息系统才是 VCL 的关键地方。整个程序的执行过程全在里面。
我又从你这里学到一点汇编知识，知识就是这样积累出来的呀。
to everybody,
其实要看懂文中的汇编并不难，我做的这件工作只是 Delphi 的基础而已。读懂和会用根本上是两回事。
我现在正在分析 TWinControl 如何如何封装 Windows 的消息系统，二天过去，进展不大。相关的函数太多了，还有一些汇编夹在其中。我认为消息系统才是 VCL 的关键地方。整个程序的执行过程全在里面。
来自： tingliuxingyu,
时间：2004-1-5 10:56:00,
ID：2393353
高手啊，高手，想法啊，想法，学习啊，学习
来自： book523,
时间：2004-1-5 11:35:00,
ID：2393464
我认为 Borland 应该对 AComp := AComp.Create 调用提示为语法错误。我实在是想不到什么时候会需要这种形式的调用。
--------------------------------------------------------------------------------
看看TApplication的CreateForm过程,有一个典型的
AComp := AComp.Create 例子，有些时候生成的汇编是不知所云，
那是因为我们对汇编根本就不了解，汇编的语句单个拿出来都很好懂，
但是要一段拿出来要明白要实现什么功能就困难了。
procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
Instance: TComponent;
begin
Instance := TComponent(InstanceClass.NewInstance); //调用NewInstance方法分配内存，创建框架等等。然后根据TComponent类圈定框架赋给Instance
TComponent(Reference) := Instance;//给Reference变量赋值
try
Instance.Create(Self);//执行constructor Create(Owner) 的代码
except
TComponent(Reference) := nil;
raise;
end;
if (FMainForm = nil) and (Instance is TForm) then
begin
TForm(Instance).HandleNeeded; //调用HandleNeeded过程，创建窗体。
FMainForm := TForm(Instance);//把第一个创建的窗体作为主窗体。
end;
end;
--------------------------------------------------------------------------------
看看TApplication的CreateForm过程,有一个典型的
AComp := AComp.Create 例子，有些时候生成的汇编是不知所云，
那是因为我们对汇编根本就不了解，汇编的语句单个拿出来都很好懂，
但是要一段拿出来要明白要实现什么功能就困难了。
procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
Instance: TComponent;
begin
Instance := TComponent(InstanceClass.NewInstance); //调用NewInstance方法分配内存，创建框架等等。然后根据TComponent类圈定框架赋给Instance
TComponent(Reference) := Instance;//给Reference变量赋值
try
Instance.Create(Self);//执行constructor Create(Owner) 的代码
except
TComponent(Reference) := nil;
raise;
end;
if (FMainForm = nil) and (Instance is TForm) then
begin
TForm(Instance).HandleNeeded; //调用HandleNeeded过程，创建窗体。
FMainForm := TForm(Instance);//把第一个创建的窗体作为主窗体。
end;
end;
来自： savetime,
时间：2004-1-5 11:53:00,
ID：2393534
to book523,
我又错了，你真的找出了这样的代码，厉害！我要考虑一下再回复你。
我又错了，你真的找出了这样的代码，厉害！我要考虑一下再回复你。
来自： book523,
时间：2004-1-5 12:41:00,
ID：2393636
我现在正在分析 TWinControl 如何如何封装 Windows 的消息系统，二天过去，进展不大。相关的函数太多了，还有一些汇编夹在其中。我认为消息系统才是 VCL 的关键地方。整个程序的执行过程全在里面。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
我现在也在做这个工作，昨天看了李维的那本新书《inside vcl》开始有点头绪了，
你不要从TWinControl开始，那样会不知所云，你可以从项目工程文件的那三句话开始
分析，估计很快就能理出个大概来。
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
我现在也在做这个工作，昨天看了李维的那本新书《inside vcl》开始有点头绪了，
你不要从TWinControl开始，那样会不知所云，你可以从项目工程文件的那三句话开始
分析，估计很快就能理出个大概来。
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
来自： book523,
时间：2004-1-5 12:45:00,
ID：2393645
我又错了，你真的找出了这样的代码，厉害！我要考虑一下再回复你。
---------------------------------------------------------------
正好昨天分析这个过程看到的。
---------------------------------------------------------------
正好昨天分析这个过程看到的。
来自： zeroyou,
时间：2004-1-5 13:41:00,
ID：2393797
到此一游，
来自： savetime,
时间：2004-1-5 13:50:00,
ID：2393802
to book523,
我找到错误的的原因了。我把汇编代码 jz 和 jl 搞混了，所以上面注释 System._ClassCreate 有错误。
其实 dl 寄存器有 3 种状态(我原来以为是 2 种)：
dl = 1 是在 TClass.Create 之前被设置
dl = 0 是在 Inherited 之前被设置
dl = -1 是在 Object.Create 之前被设置
dl = 1 System._ClassCreate 被调用
dl = 0 System._ClassCreate 不被调用
dl = -1 System._ClassCreate 被调用, 但不执行 NewInstance 工作，只是设置异常断点
“⊙测试目标：以 object reference 和 class reference 调用构造函数的编译器实现” —— 的注释也有错误。
重读 Obj.Create 的汇编代码，终于明白了应该是有 Object Reference consturction 这一事实。只是在 Obj.Create 之前必须用 NewInstance 分配内存和设置 Obj VMT 的指针，否则 Obj.Create 就会失败。Obj.Create 不会调用 NewInstance，但会设置异常处理，保证出错时析构函数被调用。
====================================
对于 VCL 的消息系统，我原本也想从上向下读，不过我对 TWinControl 没什么了解，只好先看它都包装了哪些函数。我现在可以用你推荐的方法试试。
我猜想 TApplication 只是调用 GetMessage 再 DispatchMessage，所以关键的是 VCL 如何注册 WndProc，并把注册的这个 WndProc 关联到对象上。
MakeObjectInstance 很有意思，在内存中建立一块一块的 ObjectInstance 代码，ObjectInstance 的地址又被注册为标准的 Windows Procedure。
我是从 TWinControl.Create 入手的，第一句不太明白，
FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
{ function MakeObjectInstance(Method: TWndMethod): Pointer }
你能解释一下 MakeObjectInstance 的 MainWndProc 传递的实际内容是什么(是不是传递 MainWndProc 的指针和 Self 指针？我是不太明白为什么编译器知道要把 Self 传过去。)
====================================
你已经拿到 Inside VCL 了，幸福啊。我们这里的书店太差了，到今天还没通知我到货。
我找到错误的的原因了。我把汇编代码 jz 和 jl 搞混了，所以上面注释 System._ClassCreate 有错误。
其实 dl 寄存器有 3 种状态(我原来以为是 2 种)：
dl = 1 是在 TClass.Create 之前被设置
dl = 0 是在 Inherited 之前被设置
dl = -1 是在 Object.Create 之前被设置
dl = 1 System._ClassCreate 被调用
dl = 0 System._ClassCreate 不被调用
dl = -1 System._ClassCreate 被调用, 但不执行 NewInstance 工作，只是设置异常断点
“⊙测试目标：以 object reference 和 class reference 调用构造函数的编译器实现” —— 的注释也有错误。
重读 Obj.Create 的汇编代码，终于明白了应该是有 Object Reference consturction 这一事实。只是在 Obj.Create 之前必须用 NewInstance 分配内存和设置 Obj VMT 的指针，否则 Obj.Create 就会失败。Obj.Create 不会调用 NewInstance，但会设置异常处理，保证出错时析构函数被调用。
====================================
对于 VCL 的消息系统，我原本也想从上向下读，不过我对 TWinControl 没什么了解，只好先看它都包装了哪些函数。我现在可以用你推荐的方法试试。
我猜想 TApplication 只是调用 GetMessage 再 DispatchMessage，所以关键的是 VCL 如何注册 WndProc，并把注册的这个 WndProc 关联到对象上。
MakeObjectInstance 很有意思，在内存中建立一块一块的 ObjectInstance 代码，ObjectInstance 的地址又被注册为标准的 Windows Procedure。
我是从 TWinControl.Create 入手的，第一句不太明白，
FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
{ function MakeObjectInstance(Method: TWndMethod): Pointer }
你能解释一下 MakeObjectInstance 的 MainWndProc 传递的实际内容是什么(是不是传递 MainWndProc 的指针和 Self 指针？我是不太明白为什么编译器知道要把 Self 传过去。)
====================================
你已经拿到 Inside VCL 了，幸福啊。我们这里的书店太差了，到今天还没通知我到货。
来自： baifeng,
时间：2004-1-5 13:52:00,
ID：2393836
g z
来自： book523,
时间：2004-1-5 14:26:00,
ID：2393903
你能解释一下 MakeObjectInstance 的 MainWndProc 传递的实际内容是什么(是不是传递 MainWndProc 的指针
和 Self 指针？我是不太明白为什么编译器知道要把 Self 传过去。)
============================================================================
传递的是MainWndProc 的指针和 Self 指针，看delphi的消息结构：
TMessage = packed record
Msg: Cardinal;
case Integer of
0: (
WParam: Longint;
LParam: Longint;
Result: Longint);
1: (
WParamLo: Word;
WParamHi: Word;
LParamLo: Word;
LParamHi: Word;
ResultLo: Word;
ResultHi: Word);
end;
而windows中的消息结构：
typedef struct tagMSG
{
HWND hwnd;
UINT message;
WPARAM wParam;
LPARAM lParam;
DWORD time;
POINT pt;
} MSG;
显然少了一个最重要的field即窗口句柄hwnd。
因此在delphi中处理消息的方法都会把self作为隐含参数，
把self压入到EAX中，再把TMessage 结构的指针作为第二个参数，放入EDX中，
这样才符合windows的回调函数的格式，
实际上MainWndProc 正是delphi窗体类的回调函数。
和 Self 指针？我是不太明白为什么编译器知道要把 Self 传过去。)
============================================================================
传递的是MainWndProc 的指针和 Self 指针，看delphi的消息结构：
TMessage = packed record
Msg: Cardinal;
case Integer of
0: (
WParam: Longint;
LParam: Longint;
Result: Longint);
1: (
WParamLo: Word;
WParamHi: Word;
LParamLo: Word;
LParamHi: Word;
ResultLo: Word;
ResultHi: Word);
end;
而windows中的消息结构：
typedef struct tagMSG
{
HWND hwnd;
UINT message;
WPARAM wParam;
LPARAM lParam;
DWORD time;
POINT pt;
} MSG;
显然少了一个最重要的field即窗口句柄hwnd。
因此在delphi中处理消息的方法都会把self作为隐含参数，
把self压入到EAX中，再把TMessage 结构的指针作为第二个参数，放入EDX中，
这样才符合windows的回调函数的格式，
实际上MainWndProc 正是delphi窗体类的回调函数。
来自： book523,
时间：2004-1-5 14:32:00,
ID：2393915
你上面对Create过程的跟踪分析真是精辟啊，令人佩服啊。
====================================＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
你已经拿到 Inside VCL 了，幸福啊。我们这里的书店太差了，到今天还没通知我到货。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
我是在dearbook上订了，12。31号订的，2。2号就拿到了。
====================================＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
你已经拿到 Inside VCL 了，幸福啊。我们这里的书店太差了，到今天还没通知我到货。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
我是在dearbook上订了，12。31号订的，2。2号就拿到了。
来自： book523,
时间：2004-1-5 14:39:00,
ID：2393940
to savetime:
看到了帖子吗：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=584889
我从收藏夹中提上来的。
看到了帖子吗：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=584889
我从收藏夹中提上来的。
来自： savetime,
时间：2004-1-5 16:24:00,
ID：2394288
看到，正在研究。
来自： WoDing,
时间：2004-1-5 21:24:00,
ID：2394955
留下记号，到此一游
来自： kk2000,
时间：2004-1-6 9:45:00,
ID：2395470
TO:savetime 、积步 我也正在学习汇编。其实我也有savetime的想法。可是自己能力
和时间的问题。只能向你们学习了。关于：积步兄的问题确实有趣！而且 savetime兄的回答就精妙了！ 现在我调试一下结果是下面的：
1.这是(savetime)做的：MOV ECX, TA(EBX).FA; // 通知编译器 EBX 指向的是 TA class
其实这句话可以这样翻译过来（这是我的个人看法，有步不的地方请指正）：
asm
MOV EAX, [A];//这句是把这个实例的引用传进寄存器EAX,也就是堆中的首地址
//MOV EAX,TA(EAX).FA;
MOV tmpInt,EAX ;//这里是把寄存器中的值（也就是实例的首地址，而不是变量的地址）传给tempInt;
end;
//在这里也就是相当于(savetime)的那句话了
ShowMessage(IntToStr(TA(tmpInt).FA));
2.这是（积步）提问的：
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV ECX, A; //為什麼A.FA => 100 立即數就可以顯示為 100, 如果不改就顯示為其它值。(这里修改一下)
MOV tmpInt, ECX;
end;
ShowMessage(IntToStr(TA(tmpInt).FA));//主意这里如果改为这样就对了，这里可能是编译器做的
A.Free;
end;
其实（积步）的做法就是得到这个类的段地址的FA的偏移地址。而不是该地址
里面的内容，至于怎么样取出我们要找到该变量地址的值，就象(savetime)那样
做！但是那样那做为什么能够取出他的值？后来（积步）用寄存器加上立即数也可以
取出来，我还是模糊？？？
和时间的问题。只能向你们学习了。关于：积步兄的问题确实有趣！而且 savetime兄的回答就精妙了！ 现在我调试一下结果是下面的：
1.这是(savetime)做的：MOV ECX, TA(EBX).FA; // 通知编译器 EBX 指向的是 TA class
其实这句话可以这样翻译过来（这是我的个人看法，有步不的地方请指正）：
asm
MOV EAX, [A];//这句是把这个实例的引用传进寄存器EAX,也就是堆中的首地址
//MOV EAX,TA(EAX).FA;
MOV tmpInt,EAX ;//这里是把寄存器中的值（也就是实例的首地址，而不是变量的地址）传给tempInt;
end;
//在这里也就是相当于(savetime)的那句话了
ShowMessage(IntToStr(TA(tmpInt).FA));
2.这是（积步）提问的：
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
tmpInt: Integer;
begin
A := TA.Create;
tmpInt := 0;
A.SetA(100);
asm
MOV ECX, A; //為什麼A.FA => 100 立即數就可以顯示為 100, 如果不改就顯示為其它值。(这里修改一下)
MOV tmpInt, ECX;
end;
ShowMessage(IntToStr(TA(tmpInt).FA));//主意这里如果改为这样就对了，这里可能是编译器做的
A.Free;
end;
其实（积步）的做法就是得到这个类的段地址的FA的偏移地址。而不是该地址
里面的内容，至于怎么样取出我们要找到该变量地址的值，就象(savetime)那样
做！但是那样那做为什么能够取出他的值？后来（积步）用寄存器加上立即数也可以
取出来，我还是模糊？？？
来自： savetime,
时间：2004-1-6 10:19:00,
ID：2395616
to kk2000:
你的问题很简单
MOV EAX, A; // A 是指向对象的指针，这句把对象在内存中的地址存入 EAX
这时 EAX + 4 就是对象的第一个成员变量
TA(EAX).FA 就是 EAX 加上 FA 的偏移处的内容
这是 Delphi 语法支持的，能大概看得懂就行了。
你可是解决了一个大问题，不用汇编也能访问私有成员，我原以为是汇编的特权呢。
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
begin
A := TA.Create;
A.SetA(100);
ShowMessage(IntToStr(TA(A).FA));
A.Free;
end;
你的问题很简单
MOV EAX, A; // A 是指向对象的指针，这句把对象在内存中的地址存入 EAX
这时 EAX + 4 就是对象的第一个成员变量
TA(EAX).FA 就是 EAX 加上 FA 的偏移处的内容
这是 Delphi 语法支持的，能大概看得懂就行了。
你可是解决了一个大问题，不用汇编也能访问私有成员，我原以为是汇编的特权呢。
procedure TForm1.Button1Click(Sender: TObject);
var
A: TA;
begin
A := TA.Create;
A.SetA(100);
ShowMessage(IntToStr(TA(A).FA));
A.Free;
end;
来自： savetime,
时间：2004-1-6 10:28:00,
ID：2395657
我错了，我忘记同一个单元的类可以互相访问私有成员，真是该死。
来自： chnplzh,
时间：2004-1-6 10:40:00,
ID：2395707
收藏！
来自： book523,
时间：2004-1-6 11:47:00,
ID：2395949
to savetime:
你做什么工作啊，好像挺有时间的啊。
有时间到 www.01cn.net上看看，是个好地方啊。
你做什么工作啊，好像挺有时间的啊。
有时间到 www.01cn.net上看看，是个好地方啊。
来自： savetime,
时间：2004-1-6 12:05:00,
ID：2396007
to book523,
www.01cn.net 真是高手云集啊，收藏！
我在公司做杂务，主要是收发货、检查客户退回来的产品。我总是尽快把杂务处理掉，其他的时间就自己写点小程序，读读书。我也想去软件公司，可是没有人要我，学历太低，专业知识也不够。只好先混着。
www.01cn.net 真是高手云集啊，收藏！
我在公司做杂务，主要是收发货、检查客户退回来的产品。我总是尽快把杂务处理掉，其他的时间就自己写点小程序，读读书。我也想去软件公司，可是没有人要我，学历太低，专业知识也不够。只好先混着。
来自： ka52,
时间：2004-1-6 12:43:00,
ID：2396097
看了看.感觉这才是真正的高手之路 .
可偶对汇编太没感觉了..我开始看看vcl吧 :)
可偶对汇编太没感觉了..我开始看看vcl吧 :)
来自： Walnut_Tom,
时间：2004-1-6 13:52:00,
ID：2396282
这里也是高手如云呀
来自： book523,
时间：2004-1-6 14:03:00,
ID：2396310
01cn上很多都是在这里已成名的高手。
当然现在人气还不够。
当然现在人气还不够。
来自： savetime,
时间：2004-1-6 16:08:00,
ID：2396594
昨天只看完了 Windows Callback FObjectInstance 方法的汇编代码。如果 Borland 把 TMessage 设计为 Result 字段在最前面，就不用把 Windows 回调前在堆栈中建立的参数再 PUSH 一遍了，直接把 Windows 传过来的 HWND 设置为 0 后当作 Result 用就行了(因为MainWndProc 并没有使用到 HWND)。这样的话 StdWndProc 就可以设计为只有一段小段代码而不是函数，处理消息的效率可以稍微提高一点。看来 Borland 宁愿降低效率也不愿放弃语法的美感。
下面是从 Windows Callback 开始到 TWinControl.MainWndProc 被调用的汇编代码：
DispatchMessage(&Msg) // Windows 准备回调
Windows 准备回调 TWinControl.FObjectInstance:
push LPARAM
push WPARAM
push UINT
push HWND
push (eip.Next) ; 把Windows Callback后下一条语句的地址保存在堆栈中
jmp FObjectInstance.Code
FObjectInstance.Code 只有一条 call 语句:
call ObjectInstance.offset
push eip.Next
jmp InstanceBlock.Code ;调用 InstanceBlock.Code
InstanceBlock.Code:
pop ecx ;将 eip.Next 的值存入 ecx, 用于取 @MainWndProc 和 Self
jmp StdWndProc ;跳转至 StdWndProc
StdWndProc 的反汇编代码:
function StdWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; assembler;
asm
push ebp
mov ebp, esp
XOR EAX,EAX
xor eax, eax
PUSH EAX
push eax ; TMessage.Result := 0
PUSH LParam
push dword ptr [ebp+$14]
PUSH WParam
push dword ptr [ebp+$10]
PUSH Message
push dword ptr [ebp+$0c]
MOV EDX,ESP
mov edx, esp ; mov edx, var TMessage
MOV EAX,[ECX].Longint[4]
mov eax, [ecx+$04] ; mov eax, Self
CALL [ECX].Pointer
call dword ptr [ecx] : call MainWndProc
ADD ESP,12
add esp, $0c
POP EAX
pop eax
end;
pop ebp
ret $0010
mov eax, eax
对于 VCL 消息系统的学习，这只是个开始。在 TWinControl.CreateWnd 方法中设置断点，查看什么时候建立窗口，结果看到的调用堆栈是下面这样：
TWinControl.CreateWnd
TScrollingWinControl.CreateWnd
TCustomForm.CreateWnd
TWinControl.CreateHandle
TWinControl.HandleNeeded
TWinControl.GetHandle
TWinControl.GetDeviceContext(0)
TControlCanvas.CreateHandle
TCanvas.RequiredState([csHandleValid..csFontValid])
TCanvas.TextExtent('0')
TCanvas.TextHeight('0')
TCustomForm.GetTextHeight
TCustomForm.ReadState($9525B4)
TReader.ReadRootComponent($951FA8)
TStream.ReadComponent($951FA8)
InternalReadComponentRes('TForm1',4194304,$951FA8)
InitComponent(TForm1)
InitInheritedComponent($951FA8,TForm)
TCustomForm.Create($9517C8)
TApplication.CreateForm(TForm1,(no value))
Project1
真是太复杂了，除了硬着头皮一行行代码读下去，还有什么好办法呢？
下面是从 Windows Callback 开始到 TWinControl.MainWndProc 被调用的汇编代码：
DispatchMessage(&Msg) // Windows 准备回调
Windows 准备回调 TWinControl.FObjectInstance:
push LPARAM
push WPARAM
push UINT
push HWND
push (eip.Next) ; 把Windows Callback后下一条语句的地址保存在堆栈中
jmp FObjectInstance.Code
FObjectInstance.Code 只有一条 call 语句:
call ObjectInstance.offset
push eip.Next
jmp InstanceBlock.Code ;调用 InstanceBlock.Code
InstanceBlock.Code:
pop ecx ;将 eip.Next 的值存入 ecx, 用于取 @MainWndProc 和 Self
jmp StdWndProc ;跳转至 StdWndProc
StdWndProc 的反汇编代码:
function StdWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; assembler;
asm
push ebp
mov ebp, esp
XOR EAX,EAX
xor eax, eax
PUSH EAX
push eax ; TMessage.Result := 0
PUSH LParam
push dword ptr [ebp+$14]
PUSH WParam
push dword ptr [ebp+$10]
PUSH Message
push dword ptr [ebp+$0c]
MOV EDX,ESP
mov edx, esp ; mov edx, var TMessage
MOV EAX,[ECX].Longint[4]
mov eax, [ecx+$04] ; mov eax, Self
CALL [ECX].Pointer
call dword ptr [ecx] : call MainWndProc
ADD ESP,12
add esp, $0c
POP EAX
pop eax
end;
pop ebp
ret $0010
mov eax, eax
对于 VCL 消息系统的学习，这只是个开始。在 TWinControl.CreateWnd 方法中设置断点，查看什么时候建立窗口，结果看到的调用堆栈是下面这样：
TWinControl.CreateWnd
TScrollingWinControl.CreateWnd
TCustomForm.CreateWnd
TWinControl.CreateHandle
TWinControl.HandleNeeded
TWinControl.GetHandle
TWinControl.GetDeviceContext(0)
TControlCanvas.CreateHandle
TCanvas.RequiredState([csHandleValid..csFontValid])
TCanvas.TextExtent('0')
TCanvas.TextHeight('0')
TCustomForm.GetTextHeight
TCustomForm.ReadState($9525B4)
TReader.ReadRootComponent($951FA8)
TStream.ReadComponent($951FA8)
InternalReadComponentRes('TForm1',4194304,$951FA8)
InitComponent(TForm1)
InitInheritedComponent($951FA8,TForm)
TCustomForm.Create($9517C8)
TApplication.CreateForm(TForm1,(no value))
Project1
真是太复杂了，除了硬着头皮一行行代码读下去，还有什么好办法呢？
来自： savetime,
时间：2004-1-6 17:55:00,
ID：2396907
浏览了一个 Application 的执行过程，把过程简单描述一下：
begin
首先调用了一个隐含的过程 _InitExe
_InitExe 初始化了 Module 信息，然后调用 _StartExe
_StartExe 设置异常等，然后调用 InitUnits
InitUnits 调用各个 Units 的 Initialization 段
其中调用到了 Controls.pas 的 Initializaiotn 段
Controls.Initialization 调用 InitControls
InitControls 主要建立 Mouse, Screen和 Application 实例
Application.Create 调用 Application.CreateHandle
Application.CreateHandle 建立一个窗口，并设置 Application.WndProc 为回调函数
Application.WndProc 主要处理一些应用程序级别的消息
然后才是 Project 的第一句： Application.Initialize;
这个过程基本上没有内容，主要是让用户设置一个初始化函数
然后是 Project 的第二句： Application.CreateForm(TForm1, Form1);
新增 Form1的内存实例
调用 Form1.Create -> TCustomForm.Create(Self)
TCustomForm.Create 调用 InitInheritedComponent
InitInheritedComponent 调用 InternalReadComponentRes
InternalReadComponentRes 调用 TStream.ReadComponent
TReader.ReadRootComponent 调用 TCustomForm.ReadState
TCustomForm.ReadState 调用到了 GetTextHeight
TCustomForm.GetTextHeight 调用 TCanvas.TextHeight
TCanvas.TextExtent 调用 TCanvas.RequiredState
这时候才标识出 TControlCanvas.CreateHandle
TControlCanvas.CreateHandle 又调用了 TWinControl.GetDeviceContext
TWinControl.GetDeviceContext 要求使用 Handle 于是调用 TWinControl.GetHandle
TWinControl.GetHandle 需要HWnd，于是调用TWinControl.HandleNeeded
由于没有建立 HWnd，于是调用 TWinControl.CreateHandle
TWinControl.CreateHandle 这才调用 TCustomForm.CreateWnd 建立窗口
TCustomForm.CreateWnd 调用 TScrollingWinControl.CreateWnd
TScrollingWinControl.CreateWnd 调用 TWinControl.CreateWnd这时才真正建立了一个窗口
真是漫漫长路。
最后是：Application.Run;
我还没看代码，估计是建立消息循环之类。
看来不能这样跟踪，相关流操作太多，今天回家单独建立一个 TForm 跟踪一下。
下班了!
begin
首先调用了一个隐含的过程 _InitExe
_InitExe 初始化了 Module 信息，然后调用 _StartExe
_StartExe 设置异常等，然后调用 InitUnits
InitUnits 调用各个 Units 的 Initialization 段
其中调用到了 Controls.pas 的 Initializaiotn 段
Controls.Initialization 调用 InitControls
InitControls 主要建立 Mouse, Screen和 Application 实例
Application.Create 调用 Application.CreateHandle
Application.CreateHandle 建立一个窗口，并设置 Application.WndProc 为回调函数
Application.WndProc 主要处理一些应用程序级别的消息
然后才是 Project 的第一句： Application.Initialize;
这个过程基本上没有内容，主要是让用户设置一个初始化函数
然后是 Project 的第二句： Application.CreateForm(TForm1, Form1);
新增 Form1的内存实例
调用 Form1.Create -> TCustomForm.Create(Self)
TCustomForm.Create 调用 InitInheritedComponent
InitInheritedComponent 调用 InternalReadComponentRes
InternalReadComponentRes 调用 TStream.ReadComponent
TReader.ReadRootComponent 调用 TCustomForm.ReadState
TCustomForm.ReadState 调用到了 GetTextHeight
TCustomForm.GetTextHeight 调用 TCanvas.TextHeight
TCanvas.TextExtent 调用 TCanvas.RequiredState
这时候才标识出 TControlCanvas.CreateHandle
TControlCanvas.CreateHandle 又调用了 TWinControl.GetDeviceContext
TWinControl.GetDeviceContext 要求使用 Handle 于是调用 TWinControl.GetHandle
TWinControl.GetHandle 需要HWnd，于是调用TWinControl.HandleNeeded
由于没有建立 HWnd，于是调用 TWinControl.CreateHandle
TWinControl.CreateHandle 这才调用 TCustomForm.CreateWnd 建立窗口
TCustomForm.CreateWnd 调用 TScrollingWinControl.CreateWnd
TScrollingWinControl.CreateWnd 调用 TWinControl.CreateWnd这时才真正建立了一个窗口
真是漫漫长路。
最后是：Application.Run;
我还没看代码，估计是建立消息循环之类。
看来不能这样跟踪，相关流操作太多，今天回家单独建立一个 TForm 跟踪一下。
下班了!
来自： xzgyb,
时间：2004-1-7 21:02:00,
ID：2399360
最近在看<>,对windows编程稍懂了点，下午照vcl抄了一下，只是主要的窗口建立部分，不知对你有没有用，如下
unit MyWindowUnit;
interface
uses Windows, SysUtils, Messages;
type
TMyCreateParams = record
Caption: PChar;
Style: DWORD;
ExStyle: DWORD;
X, Y: Integer;
Width, Height: Integer;
WndParent: HWnd;
Param: Pointer;
WindowClass: TWndClass;
WinClassName: array[0..63] of Char;
end;
TMyMessage = packed record
Msg: Cardinal;
case Integer of
0: (
WParam: Longint;
LParam: Longint;
Result: Longint);
1: (
WParamLo: Word;
WParamHi: Word;
LParamLo: Word;
LParamHi: Word;
ResultLo: Word;
ResultHi: Word);
end;
TMyWndMethod = procedure(var Message: TMyMessage) of object;
TMyWindow = class
private
FHandle: HWnd;
FDefWndProc: Pointer;
FObjectInstance: Pointer;
function GetHandle: HWnd;
protected
procedure CreateWindowHandle(const Params: TMyCreateParams); virtual;
procedure CreateParams(var Params: TMyCreateParams); virtual;
procedure CreateHandle; virtual;
procedure CreateWnd; virtual;
procedure WndProc(var Message: TMyMessage); virtual;
procedure MainWndProc(var Message: TMyMessage);
public
procedure DefaultHandler(var Message); override;
procedure HandleNeeded;
procedure ShowWindow;
procedure UpdateWindow;
constructor Create; virtual;
property Handle: HWnd read GetHandle;
end;
implementation
{ TMyWindow }
type
PMyObjectInstance = ^TMyObjectInstance;
TMyObjectInstance = packed record
CodeCall: Byte;
Offset: Integer;
Method: TMyWndMethod;
CodeJmp: array[1..2] of Byte;
WndProcPtr: Pointer;
end;
function MyStdWndProc(Window: HWND; Message, WParam: Longint;
LParam: Longint): Longint; stdcall; assembler;
asm
XOR EAX,EAX
PUSH EAX
PUSH LParam
PUSH WParam
PUSH Message
MOV EDX,ESP
MOV EAX,[ECX].Longint[4]
CALL [ECX].Pointer
ADD ESP,12
POP EAX
end;
function MyCalcJmpOffset(Src, Dest: Pointer): Longint;
begin
Result := Longint(Dest) - (Longint(Src) + 5);
end;
function MyMakeObjectInstance(Method: TMyWndMethod): Pointer;
const
BlockCode: array[1..2] of Byte = (
$59, { POP ECX }
$E9); { JMP MyStdWndProc }
var
PBlock: PMyObjectInstance;
begin
PBlock := VirtualAlloc(nil, SizeOf(TMyObjectInstance), MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
Move(BlockCode, PBlock^.CodeJmp, SizeOf(BlockCode));
PBlock^.WndProcPtr := Pointer(MyCalcJmpOffset(@PBlock^.CodeJmp[2], @MyStdWndProc));
PBlock^.CodeCall := $E8;
PBlock^.Offset := MyCalcJmpOffset(PBlock, @PBlock^.CodeJmp);
PBlock^.Method := Method;
Result := PBlock;
end;
constructor TMyWindow.Create;
begin
FObjectInstance := MyMakeObjectInstance(MainWndProc);
end;
procedure TMyWindow.CreateHandle;
begin
if FHandle = 0 then CreateWnd;
end;
procedure TMyWindow.CreateParams(var Params: TMyCreateParams);
begin
FillChar(Params, SizeOf(Params), 0);
with Params do
begin
Style := WS_OVERLAPPEDWINDOW;
WndParent := 0;
WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
WindowClass.lpfnWndProc := @DefWindowProc;
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hbrBackground := COLOR_3DFACE + 1;
WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION);
WindowClass.hInstance := HInstance;
StrPCopy(WinClassName, Self.ClassName);
end;
end;
procedure TMyWindow.CreateWindowHandle(const Params: TMyCreateParams);
begin
with Params do
FHandle := CreateWindow(WinClassName, Caption, Style,
X, Y,
Width, Height,
WndParent, 0, WindowClass.hInstance, Param);
end;
var
MyCreationControl: TMyWindow;
function MyInitWndProc(HWindow: HWnd; Message, WParam,
LParam: Longint): Longint; stdcall;
begin
MyCreationControl.FHandle := HWindow;
SetWindowLong(HWindow, GWL_WNDPROC,
LongInt(MyCreationControl.FObjectInstance));
asm
PUSH LParam
PUSH WParam
PUSH Message
PUSH HWindow
MOV EAX,MyCreationControl
MOV MyCreationControl,0
CALL [EAX].TMyWindow.FObjectInstance
MOV Result,EAX
end;
end;
procedure TMyWindow.CreateWnd;
var
Params: TMyCreateParams;
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
CreateParams(Params);
with Params do
begin
FDefWndProc := WindowClass.lpfnWndProc;
ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @MyInitWndProc) then
begin
if ClassRegistered then Windows.UnregisterClass(WinClassName,
WindowClass.hInstance);
WindowClass.lpfnWndProc := @MyInitWndProc;
WindowClass.lpszClassName := WinClassName;
if Windows.RegisterClass(WindowClass) = 0 then RaiseLastOSError;
end;
MyCreationControl := Self;
CreateWindowHandle(Params);
if FHandle = 0 then RaiseLastOSError;
end;
end;
procedure TMyWindow.DefaultHandler(var Message);
begin
if FHandle <> 0 then
with TMessage(Message) do
Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
end;
function TMyWindow.GetHandle: HWnd;
begin
HandleNeeded;
Result := FHandle;
end;
procedure TMyWindow.HandleNeeded;
begin
if FHandle = 0 then CreateHandle;
end;
procedure TMyWindow.MainWndProc(var Message: TMyMessage);
begin
WndProc(Message);
end;
procedure TMyWindow.ShowWindow;
begin
Windows.ShowWindow(FHandle, CmdShow);
end;
procedure TMyWindow.UpdateWindow;
begin
Windows.UpdateWindow(FHandle);
end;
procedure TMyWindow.WndProc(var Message: TMyMessage);
begin
if Message.Msg = WM_DESTROY then
PostQuitMessage(0)
else
Dispatch(Message);
end;
end.
dpr文件建立一消息循环，如下:
program Project1;
uses
Windows,
MyWindowUnit in 'MyWindowUnit.pas';
{$R *.res}
var
MyWindow: TMyWindow;
hWindow: HWND;
msg: TMsg;
begin
MyWindow := TMyWindow.Create;
hWindow := MyWindow.Handle;
MyWindow.ShowWindow;
MyWindow.UpdateWindow;
while GetMessage(msg, 0, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
MyWindow.Free;
end.
unit MyWindowUnit;
interface
uses Windows, SysUtils, Messages;
type
TMyCreateParams = record
Caption: PChar;
Style: DWORD;
ExStyle: DWORD;
X, Y: Integer;
Width, Height: Integer;
WndParent: HWnd;
Param: Pointer;
WindowClass: TWndClass;
WinClassName: array[0..63] of Char;
end;
TMyMessage = packed record
Msg: Cardinal;
case Integer of
0: (
WParam: Longint;
LParam: Longint;
Result: Longint);
1: (
WParamLo: Word;
WParamHi: Word;
LParamLo: Word;
LParamHi: Word;
ResultLo: Word;
ResultHi: Word);
end;
TMyWndMethod = procedure(var Message: TMyMessage) of object;
TMyWindow = class
private
FHandle: HWnd;
FDefWndProc: Pointer;
FObjectInstance: Pointer;
function GetHandle: HWnd;
protected
procedure CreateWindowHandle(const Params: TMyCreateParams); virtual;
procedure CreateParams(var Params: TMyCreateParams); virtual;
procedure CreateHandle; virtual;
procedure CreateWnd; virtual;
procedure WndProc(var Message: TMyMessage); virtual;
procedure MainWndProc(var Message: TMyMessage);
public
procedure DefaultHandler(var Message); override;
procedure HandleNeeded;
procedure ShowWindow;
procedure UpdateWindow;
constructor Create; virtual;
property Handle: HWnd read GetHandle;
end;
implementation
{ TMyWindow }
type
PMyObjectInstance = ^TMyObjectInstance;
TMyObjectInstance = packed record
CodeCall: Byte;
Offset: Integer;
Method: TMyWndMethod;
CodeJmp: array[1..2] of Byte;
WndProcPtr: Pointer;
end;
function MyStdWndProc(Window: HWND; Message, WParam: Longint;
LParam: Longint): Longint; stdcall; assembler;
asm
XOR EAX,EAX
PUSH EAX
PUSH LParam
PUSH WParam
PUSH Message
MOV EDX,ESP
MOV EAX,[ECX].Longint[4]
CALL [ECX].Pointer
ADD ESP,12
POP EAX
end;
function MyCalcJmpOffset(Src, Dest: Pointer): Longint;
begin
Result := Longint(Dest) - (Longint(Src) + 5);
end;
function MyMakeObjectInstance(Method: TMyWndMethod): Pointer;
const
BlockCode: array[1..2] of Byte = (
$59, { POP ECX }
$E9); { JMP MyStdWndProc }
var
PBlock: PMyObjectInstance;
begin
PBlock := VirtualAlloc(nil, SizeOf(TMyObjectInstance), MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
Move(BlockCode, PBlock^.CodeJmp, SizeOf(BlockCode));
PBlock^.WndProcPtr := Pointer(MyCalcJmpOffset(@PBlock^.CodeJmp[2], @MyStdWndProc));
PBlock^.CodeCall := $E8;
PBlock^.Offset := MyCalcJmpOffset(PBlock, @PBlock^.CodeJmp);
PBlock^.Method := Method;
Result := PBlock;
end;
constructor TMyWindow.Create;
begin
FObjectInstance := MyMakeObjectInstance(MainWndProc);
end;
procedure TMyWindow.CreateHandle;
begin
if FHandle = 0 then CreateWnd;
end;
procedure TMyWindow.CreateParams(var Params: TMyCreateParams);
begin
FillChar(Params, SizeOf(Params), 0);
with Params do
begin
Style := WS_OVERLAPPEDWINDOW;
WndParent := 0;
WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
WindowClass.lpfnWndProc := @DefWindowProc;
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hbrBackground := COLOR_3DFACE + 1;
WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION);
WindowClass.hInstance := HInstance;
StrPCopy(WinClassName, Self.ClassName);
end;
end;
procedure TMyWindow.CreateWindowHandle(const Params: TMyCreateParams);
begin
with Params do
FHandle := CreateWindow(WinClassName, Caption, Style,
X, Y,
Width, Height,
WndParent, 0, WindowClass.hInstance, Param);
end;
var
MyCreationControl: TMyWindow;
function MyInitWndProc(HWindow: HWnd; Message, WParam,
LParam: Longint): Longint; stdcall;
begin
MyCreationControl.FHandle := HWindow;
SetWindowLong(HWindow, GWL_WNDPROC,
LongInt(MyCreationControl.FObjectInstance));
asm
PUSH LParam
PUSH WParam
PUSH Message
PUSH HWindow
MOV EAX,MyCreationControl
MOV MyCreationControl,0
CALL [EAX].TMyWindow.FObjectInstance
MOV Result,EAX
end;
end;
procedure TMyWindow.CreateWnd;
var
Params: TMyCreateParams;
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
CreateParams(Params);
with Params do
begin
FDefWndProc := WindowClass.lpfnWndProc;
ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @MyInitWndProc) then
begin
if ClassRegistered then Windows.UnregisterClass(WinClassName,
WindowClass.hInstance);
WindowClass.lpfnWndProc := @MyInitWndProc;
WindowClass.lpszClassName := WinClassName;
if Windows.RegisterClass(WindowClass) = 0 then RaiseLastOSError;
end;
MyCreationControl := Self;
CreateWindowHandle(Params);
if FHandle = 0 then RaiseLastOSError;
end;
end;
procedure TMyWindow.DefaultHandler(var Message);
begin
if FHandle <> 0 then
with TMessage(Message) do
Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
end;
function TMyWindow.GetHandle: HWnd;
begin
HandleNeeded;
Result := FHandle;
end;
procedure TMyWindow.HandleNeeded;
begin
if FHandle = 0 then CreateHandle;
end;
procedure TMyWindow.MainWndProc(var Message: TMyMessage);
begin
WndProc(Message);
end;
procedure TMyWindow.ShowWindow;
begin
Windows.ShowWindow(FHandle, CmdShow);
end;
procedure TMyWindow.UpdateWindow;
begin
Windows.UpdateWindow(FHandle);
end;
procedure TMyWindow.WndProc(var Message: TMyMessage);
begin
if Message.Msg = WM_DESTROY then
PostQuitMessage(0)
else
Dispatch(Message);
end;
end.
dpr文件建立一消息循环，如下:
program Project1;
uses
Windows,
MyWindowUnit in 'MyWindowUnit.pas';
{$R *.res}
var
MyWindow: TMyWindow;
hWindow: HWND;
msg: TMsg;
begin
MyWindow := TMyWindow.Create;
hWindow := MyWindow.Handle;
MyWindow.ShowWindow;
MyWindow.UpdateWindow;
while GetMessage(msg, 0, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
MyWindow.Free;
end.