[转]Delphi的对象机制浅探

Delphi的对象机制浅探

[e-mail]
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;  

来自：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 的语句。如果你知道在混合
汇编的情况下如何使用寄存器请教我一下。

其实我真的不知道还有这种方法可以获得私有成员，有趣！  

来自：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

  

来自：savetime, 时间：2004-1-4 2:40:00, ID：2391533

to 积步,
我测试了在混合汇编的情况下修改寄存器时的实现，结果是：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中的代码。  

来自：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)
我想知道这样的结果是什么。
  

来自：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兄弟還有更高的招術， 厲害厲害!!  

来自：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 的关键地方。整个程序的执行过程全在里面。  

来自：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;  

来自：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;
  

来自：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 了，幸福啊。我们这里的书店太差了，到今天还没通知我到货。  

来自：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窗体类的回调函数。

  

来自：book523, 时间：2004-1-5 14:32:00, ID：2393915

 你上面对Create过程的跟踪分析真是精辟啊，令人佩服啊。

====================================＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

你已经拿到 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
我从收藏夹中提上来的。  

来自：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, 时间：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;
  

来自：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上看看，是个好地方啊。  

来自：savetime, 时间：2004-1-6 12:05:00, ID：2396007

to book523,
www.01cn.net 真是高手云集啊，收藏！
我在公司做杂务，主要是收发货、检查客户退回来的产品。我总是尽快把杂务处理掉，其他的时间就自己写点小程序，读读书。我也想去软件公司，可是没有人要我，学历太低，专业知识也不够。只好先混着。  

来自：ka52, 时间：2004-1-6 12:43:00, ID：2396097

看了看.感觉这才是真正的高手之路 .
可偶对汇编太没感觉了..我开始看看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

真是太复杂了，除了硬着头皮一行行代码读下去，还有什么好办法呢？
  

来自：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 跟踪一下。
下班了!  

来自：xzgyb, 时间：2004-1-7 21:02:00, ID：2399360

最近在看<<windows程序设计>>,对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.

  

来自：kk2000, 时间：2004-1-7 21:36:00, ID：2399408

  老达：　还有吗？继续。不过有些汇编还是看不懂！  

来自：savetime, 时间：2004-1-8 9:10:00, ID：2399768

xzgyb,你抄的函数都是比较关键的，不过 TControl.Parent 和 TWinControl.Showing 也是很关键的属性，你跟踪 TControl.SetParent 就知道我为什么这么说了。
昨晚梦见李维在给我讲为什么 TWndMethod 可以指向虚方法，早上一起来就给忘了。只好今天看一下汇编代码了。
我感觉我快要理清 Delphi 的消息机制了，希望周五能做个总结。  

来自：xzgyb, 时间：2004-1-8 9:58:00, ID：2399892

老K，没了，就这些，VCL一开始创建窗口的关键就是这些，
savetime:我的意思是VCL首次建窗口的时机就是发生在
GetTextHeight那段
  

来自：savetime, 时间：2004-1-8 10:09:00, ID：2399915

to xzgyb,
>> 我的意思是VCL首次建窗口的时机就是发生在GetTextHeight那段。

我阅读 VCL 代码后的理解是：
TWinControl的 继承类尽可能地推迟 CreateWindowHandle 过程的执行，为了更有效的使用资源。只有在一个控件确实需要 HWnd 时才真正创建窗口。GetTextHeight 是可能导致 CreateWindowHandle 被调用的函数之一。更常见的情况是，如下代码：
var
  Panel: TPanel;
begin
  Panel := TPanel.Create(Self);
  Panel.Parent := Self;
end;
执行完第一条语句，并不会真正创建窗口，因为 Panel 还没有显示，第二条语句执行后，会触发一系列 TControl 和 TWinControl 的事件，这时 CreateWindowHandle 才会被调用。  

来自：xzgyb, 时间：2004-1-8 13:56:00, ID：2400416

SaveTime:
哦，明白了你的意思了。
我以前的意思就是找到一个主窗口的在读取dfm后首先建立窗口的时机
其实归根结底就是当访问一个窗口的Handle时，调用HandleNeed，如果没有创建则
创建，也就是一种惰性创建的机制，呵呵，惰性还是以前跟别人学的一个词
祝你今晚还能梦到李维，呵呵

老K:系统装好了吗  

来自：kk2000, 时间：2004-1-8 14:18:00, ID：2400478

　　老达：要常来阿，让我在这里多学习一点。真的又进步了不少！　我
的系统昨天搞定了！就做个覆盖安装，好省事的。其它的东西并没有掉。　  

来自：savetime, 时间：2004-1-8 16:07:00, ID：2400797

惰性创建，有意思，在找不到更直接的称呼之前可以先用这个词 :)  

来自：book523, 时间：2004-1-8 16:41:00, ID：2400914

to savetime:
明天等你的总结啊。
看来李维今晚会梦到你啊。  

来自：savetime, 时间：2004-1-8 17:04:00, ID：2400963

to book523,
我是希望像上周五一样，一个晚上(通宵)上能够写完总结，只是这两天搬货和一堆杂事浪费了很多时间。我尽力吧。  

来自：kk2000, 时间：2004-1-9 17:52:00, ID：2403112

　TO: savetive 　不是说今天来个总结吗？　我每天都要来看看情况的！
等你的佳音。　
  

来自：savetime, 时间：2004-1-9 17:58:00, ID：2403123

to kk2000,
我正在写，我希望今晚能写完，写完后我会在这里发贴通知你。
我要下班了。  

来自：savetime, 时间：2004-1-10 0:06:00, ID：2403551

我的总结写完了，欢迎批评指正。你如果有任何疑问，我都非常乐意尽力回答。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2403549  

来自：xzh2000, 时间：2004-1-10 20:32:00, ID：2404582

真是很勤奋，savetime.  

来自：wjh_wy, 时间：2004-1-11 13:46:00, ID：2405065

又是一篇好文章，学习。  

来自：savetime, 时间：2004-1-13 12:25:00, ID：2408561

多谢各位捧场。  

来自：henry103734338, 时间：2005-8-31 11:06:59, ID：3186394

good