home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / prezent / cb / data.z / TYPINFO.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-16  |  32KB  |  1,182 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit TypInfo;
  11.  
  12. interface
  13.  
  14. uses SysUtils;
  15.  
  16. type
  17.  
  18.   TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
  19.     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkLWString,
  20.     tkVariant);
  21.   TTypeKinds = set of TTypeKind;
  22.  
  23.   TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong);
  24.  
  25.   TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
  26.  
  27.   TMethodKind = (mkProcedure, mkFunction);
  28.  
  29.   TParamFlags = set of (pfVar, pfConst, pfArray, pfAddress, pfReference);
  30.  
  31.   PTypeInfo = ^TTypeInfo;
  32.   TTypeInfo = record
  33.     Kind: TTypeKind;
  34.     Name: ShortString;
  35.    {TypeData: TTypeData}
  36.   end;
  37.  
  38.   PTypeData = ^TTypeData;
  39.   TTypeData = packed record
  40.     case TTypeKind of
  41.       tkUnknown, tkLString, tkLWString, tkVariant: ();
  42.       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
  43.         OrdType: TOrdType;
  44.         case TTypeKind of
  45.           tkInteger, tkChar, tkEnumeration, tkWChar: (
  46.             MinValue: Longint;
  47.             MaxValue: Longint;
  48.             case TTypeKind of
  49.               tkInteger, tkChar, tkWChar: ();
  50.               tkEnumeration: (
  51.                 BaseType: PTypeInfo;
  52.                 NameList: ShortString));
  53.           tkSet: (
  54.             CompType: PTypeInfo));
  55.       tkFloat: (
  56.         FloatType: TFloatType);
  57.       tkString: (
  58.         MaxLength: Byte);
  59.       tkClass: (
  60.         ClassType: TClass;
  61.         ParentInfo: PTypeInfo;
  62.         PropCount: SmallInt;
  63.         UnitName: ShortString
  64.        {PropData: TPropData});
  65.       tkMethod: (
  66.         MethodKind: TMethodKind;
  67.         ParamCount: Byte;
  68.         ParamList: array[0..1023] of Char
  69.        {ParamList: array[1..ParamCount] of
  70.           record
  71.             Flags: TParamFlags;
  72.             ParamName: ShortString;
  73.             TypeName: ShortString;
  74.           end;
  75.         ResultType: ShortString});
  76.   end;
  77.  
  78.   TPropData = packed record
  79.     PropCount: Word;
  80.     PropList: record end;
  81.    {PropList: array[1..PropCount] of TPropInfo}
  82.   end;
  83.  
  84.   PPropInfo = ^TPropInfo;
  85.   TPropInfo = packed record
  86.     PropType: PTypeInfo;
  87.     GetProc: Pointer;
  88.     SetProc: Pointer;
  89.     StoredProc: Pointer;
  90.     Index: Integer;
  91.     Default: Longint;
  92.     NameIndex: SmallInt;
  93.     Name: ShortString;
  94.   end;
  95.  
  96.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  97.  
  98.   PPropList = ^TPropList;
  99.   TPropList = array[0..16379] of PPropInfo;
  100.  
  101. const
  102.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  103.   tkMethods = [tkMethod];
  104.   tkProperties = tkAny - tkMethods - [tkUnknown];
  105.  
  106. { Property access routines }
  107.  
  108. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  109.  
  110. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  111. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  112.  
  113. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  114. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  115. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  116.   PropList: PPropList): Integer;
  117.  
  118. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  119.  
  120. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  121. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  122.   Value: Longint);
  123.  
  124. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  125. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  126.   const Value: string);
  127.  
  128. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  129. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  130.   Value: Extended);
  131.  
  132. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  133. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  134.   const Value: Variant);
  135.  
  136. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  137. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  138.   const Value: TMethod);
  139.  
  140. implementation
  141.  
  142. function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;
  143. asm
  144.         { ->    EAX Pointer to type info }
  145.         { <-    EAX Pointer to type data }
  146.         {       it's really just to skip the kind and the name  }
  147.         XOR     EDX,EDX
  148.         MOV     DL,[EAX].TTypeInfo.Name.Byte[0]
  149.         LEA     EAX,[EAX].TTypeInfo.Name[EDX+1]
  150. end;
  151.  
  152. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  153. var
  154.   P: ^ShortString;
  155. begin
  156.   P := @GetTypeData(GetTypeData(TypeInfo)^.BaseType)^.NameList;
  157.   while Value <> 0 do
  158.   begin
  159.     Inc(Integer(P), Length(P^) + 1);
  160.     Dec(Value);
  161.   end;
  162.   if (TypeInfo^.Name = 'Boolean') then       // change case of strings
  163.     Result := LowerCase(P^)
  164.   else
  165.   Result := P^;
  166. end;
  167.  
  168. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  169.   assembler;
  170. asm
  171.         { ->    EAX Pointer to type info        }
  172.         {       EDX Pointer to string           }
  173.         { <-    EAX Value                       }
  174.  
  175.         PUSH    EBX
  176.         PUSH    ESI
  177.         PUSH    EDI
  178.  
  179.     TEST    EDX,EDX
  180.     JE    @notFound
  181.  
  182.         {       point ESI to first name of the base type }
  183.         XOR     ECX,ECX
  184.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  185.         MOV     EAX,[EAX].TTypeInfo.Name[ECX+1].TTypeData.BaseType
  186.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  187.         LEA     ESI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.NameList
  188.  
  189.         {       make EDI the high bound of the enum type }
  190.         MOV     EDI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxValue
  191.  
  192.         {       EAX is our running index }
  193.         XOR     EAX,EAX
  194.  
  195.         {       make ECX the length of the current string }
  196.  
  197. @outerLoop:
  198.         MOV     CL,[ESI]
  199.     CMP    ECX,[EDX-4]
  200.         JNE     @lengthMisMatch
  201.  
  202.         {       we know for sure the names won't be zero length }
  203. @cmpLoop:
  204.         MOV     BL,[EDX+ECX-1]
  205.         XOR     BL,[ESI+ECX]
  206.         TEST    BL,0DFH
  207.         JNE     @misMatch
  208.         DEC     ECX
  209.         JNE     @cmpLoop
  210.  
  211.         {       as we didn't have a mismatch, we must have found the name }
  212.         JMP     @exit
  213.  
  214. @misMatch:
  215.         MOV     CL,[ESI]
  216. @lengthMisMatch:
  217.         INC     EAX
  218.         LEA     ESI,[ESI+ECX+1]
  219.         CMP     EAX,EDI
  220.         JLE     @outerLoop
  221.  
  222.         {       we haven't found the thing - return -1  }
  223. @notFound:
  224.         OR      EAX,-1
  225.  
  226. @exit:
  227.         POP     EDI
  228.         POP     ESI
  229.     POP    EBX
  230. end;
  231.  
  232. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  233.   assembler;
  234. asm
  235.         { ->    EAX Pointer to type info        }
  236.         {       EDX Pointer to prop name        }
  237.         { <-    EAX Pointer to prop info        }
  238.  
  239.         PUSH    EBX
  240.         PUSH    ESI
  241.         PUSH    EDI
  242.  
  243.     MOV    ECX,EDX
  244.     OR    EDX,EDX
  245.     JE    @outerLoop
  246.     MOV    CL,[EDX-4]
  247.     MOV    CH,[EDX]
  248.         AND     ECX,0DFFFH
  249.  
  250. @outerLoop:
  251.         XOR     EBX,EBX
  252.         MOV     BL,[EAX].TTypeInfo.Name.Byte[0]
  253.         LEA     ESI,[EAX].TTypeInfo.Name[EBX+1]
  254.         MOV     BL,[ESI].TTypeData.UnitName.Byte[0]
  255.         MOVZX   EDI,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropCount
  256.         TEST    EDI,EDI
  257.         JE      @parent
  258.         LEA     EAX,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropList
  259.  
  260. @innerLoop:
  261.         MOV     BX,[EAX].TPropInfo.Name.Word[0]
  262.         AND     BH,0DFH
  263.         CMP     EBX,ECX
  264.         JE      @matchStart
  265.  
  266. @nextProperty:
  267.         MOV     BH,0
  268.         DEC     EDI
  269.         LEA     EAX,[EAX].TPropInfo.Name[EBX+1]
  270.         JNE     @innerLoop
  271.  
  272. @parent:
  273.         MOV     EAX,[ESI].TTypeData.ParentInfo
  274.         TEST    EAX,EAX
  275.         JNE     @outerLoop
  276.         JMP     @exit
  277.  
  278. @misMatch:
  279.         MOV     CH,[EDX]
  280.         AND     CH,0DFH
  281.         MOV     BL,[EAX].TPropInfo.Name.Byte[0]
  282.         JMP     @nextProperty
  283.  
  284. @matchStart:
  285.         MOV     BH,0
  286.  
  287. @matchLoop:
  288.         MOV     CH,[EDX+EBX-1]
  289.         XOR     CH,[EAX].TPropInfo.Name.Byte[EBX]
  290.         TEST    CH,0DFH
  291.         JNE     @misMatch
  292.         DEC     EBX
  293.         JNE     @matchLoop
  294.  
  295. @exit:
  296.         POP     EDI
  297.         POP     ESI
  298.         POP     EBX
  299. end;
  300.  
  301. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList); assembler;
  302. asm
  303.         { ->    EAX Pointer to type info        }
  304.         {       EDX Pointer to prop list        }
  305.         { <-    nothing                         }
  306.  
  307.         PUSH    EBX
  308.         PUSH    ESI
  309.         PUSH    EDI
  310.  
  311.         XOR     ECX,ECX
  312.         MOV     ESI,EAX
  313.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  314.         MOV     EDI,EDX
  315.         XOR     EAX,EAX
  316.         MOVZX   ECX,[ESI].TTypeInfo.Name[ECX+1].TTypeData.PropCount
  317.         REP     STOSD
  318.  
  319. @outerLoop:
  320.         MOV     CL,[ESI].TTypeInfo.Name.Byte[0]
  321.         LEA     ESI,[ESI].TTypeInfo.Name[ECX+1]
  322.         MOV     CL,[ESI].TTypeData.UnitName.Byte[0]
  323.         MOVZX   EAX,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropCount
  324.         TEST    EAX,EAX
  325.         JE      @parent
  326.         LEA     EDI,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropList
  327.  
  328. @innerLoop:
  329.  
  330.         MOVZX   EBX,[EDI].TPropInfo.NameIndex
  331.         MOV     CL,[EDI].TPropInfo.Name.Byte[0]
  332.         CMP     dword ptr [EDX+EBX*4],0
  333.         JNE     @alreadySet
  334.         MOV     [EDX+EBX*4],EDI
  335.  
  336. @alreadySet:
  337.         LEA     EDI,[EDI].TPropInfo.Name[ECX+1]
  338.         DEC     EAX
  339.         JNE     @innerLoop
  340.  
  341. @parent:
  342.         MOV     ESI,[ESI].TTypeData.ParentInfo
  343.         XOR     ECX,ECX
  344.         TEST    ESI,ESI
  345.         JNE     @outerLoop
  346.  
  347.         POP     EDI
  348.         POP     ESI
  349.         POP     EBX
  350.  
  351. end;
  352.  
  353. procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler;
  354. asm
  355.         { ->    EAX Pointer to prop list        }
  356.         {       EDX Property count              }
  357.         { <-    nothing                         }
  358.  
  359.         PUSH    EBX
  360.         PUSH    ESI
  361.         PUSH    EDI
  362.         MOV     ECX,EAX
  363.         XOR     EAX,EAX
  364.         DEC     EDX
  365.         CALL    @@qsort
  366.         POP     EDI
  367.         POP     ESI
  368.         POP     EBX
  369.         JMP     @@exit
  370.  
  371. @@qsort:
  372.         PUSH    EAX
  373.         PUSH    EDX
  374.         LEA     EDI,[EAX+EDX]           { pivot := (left + right) div 2 }
  375.         SHR     EDI,1
  376.         MOV     EDI,[ECX+EDI*4]
  377.         ADD     EDI,OFFSET TPropInfo.Name
  378. @@repeat:                               { repeat                        }
  379. @@while1:
  380.         CALL    @@compare               { while a[i] < a[pivot] do inc(i);}
  381.         JAE     @@endWhile1
  382.         INC     EAX
  383.         JMP     @@while1
  384. @@endWhile1:
  385.         XCHG    EAX,EDX
  386. @@while2:
  387.         CALL    @@compare               { while a[j] > a[pivot] do dec(j);}
  388.         JBE     @@endWhile2
  389.         DEC     EAX
  390.         JMP     @@while2
  391. @@endWhile2:
  392.         XCHG    EAX,EDX
  393.         CMP     EAX,EDX                 { if i <= j then begin          }
  394.         JG      @@endRepeat
  395.         MOV     EBX,[ECX+EAX*4]         { x := a[i];                    }
  396.         MOV     ESI,[ECX+EDX*4]         { y := a[j];                    }
  397.         MOV     [ECX+EDX*4],EBX         { a[j] := x;                    }
  398.         MOV     [ECX+EAX*4],ESI         { a[i] := y;                    }
  399.         INC     EAX                     { inc(i);                       }
  400.         DEC     EDX                     { dec(j);                       }
  401.                                         { end;                          }
  402.         CMP     EAX,EDX                 { until i > j;                  }
  403.         JLE     @@repeat
  404.  
  405. @@endRepeat:
  406.         POP     ESI
  407.         POP     EBX
  408.  
  409.         CMP     EAX,ESI
  410.         JL      @@rightNonEmpty         { if i >= right then begin      }
  411.         CMP     EDX,EBX
  412.         JG      @@leftNonEmpty1         { if j <= left then exit        }
  413.         RET
  414.  
  415. @@leftNonEmpty1:
  416.         MOV     EAX,EBX
  417.         JMP     @@qsort                 { qsort(left, j)                }
  418.  
  419. @@rightNonEmpty:
  420.         CMP     EAX,EBX
  421.         JG      @@leftNonEmpty2
  422.         MOV     EDX,ESI                 { qsort(i, right)               }
  423.         JMP     @@qsort
  424. @@leftNonEmpty2:
  425.         PUSH    EAX
  426.         PUSH    ESI
  427.         MOV     EAX,EBX
  428.         CALL    @@qsort                 { qsort(left, j)                }
  429.         POP     EDX
  430.         POP     EAX
  431.         JMP     @@qsort                 { qsort(i, right)               }
  432.  
  433. @@compare:
  434.         PUSH    EAX
  435.         PUSH    EDI
  436.         MOV     ESI,[ECX+EAX*4]
  437.         ADD     ESI,OFFSET TPropInfo.Name
  438.         PUSH    ESI
  439.         XOR     EBX,EBX
  440.         MOV     BL,[ESI]
  441.         INC     ESI
  442.         CMP     BL,[EDI]
  443.         JBE     @@firstLenSmaller
  444.         MOV     BL,[EDI]
  445. @@firstLenSmaller:
  446.         INC     EDI
  447.         TEST    BL,BL
  448.         JE      @@endLoop
  449. @@loop:
  450.         MOV     AL,[ESI]
  451.         MOV     AH,[EDI]
  452.         AND     EAX,$DFDF
  453.         CMP     AL,AH
  454.         JNE     @@difference
  455.         INC     ESI
  456.         INC     EDI
  457.         DEC     EBX
  458.         JNZ     @@loop
  459. @@endLoop:
  460.         POP     ESI
  461.         POP     EDI
  462.         MOV     AL,[ESI]
  463.         MOV     AH,[EDI]
  464.         CMP     AL,AH
  465.         POP     EAX
  466.         RET
  467. @@difference:
  468.         POP     ESI
  469.         POP     EDI
  470.         POP     EAX
  471.         RET
  472. @@exit:
  473. end;
  474.  
  475. { TypeInfo is the type info of a class. Return all properties matching
  476.   TypeKinds in this class or its ancestors in PropList and return the count }
  477.  
  478. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  479.   PropList: PPropList): Integer;
  480. var
  481.   I, Count: Integer;
  482.   PropInfo: PPropInfo;
  483.   TempList: PPropList;
  484. begin
  485.   Result := 0;
  486.   Count := GetTypeData(TypeInfo)^.PropCount;
  487.   if Count > 0 then
  488.   begin
  489.     GetMem(TempList, Count * SizeOf(Pointer));
  490.     try
  491.       GetPropInfos(TypeInfo, TempList);
  492.       for I := 0 to Count - 1 do
  493.       begin
  494.         PropInfo := TempList^[I];
  495.         if PropInfo^.PropType^.Kind in TypeKinds then
  496.         begin
  497.           if PropList <> nil then PropList^[Result] := PropInfo;
  498.           Inc(Result);
  499.         end;
  500.         if (PropList <> nil) and (Result > 1) then
  501.           SortPropList(PropList, Result);
  502.       end;
  503.     finally
  504.       FreeMem(TempList, Count * SizeOf(Pointer));
  505.     end;
  506.   end;
  507. end;
  508.  
  509. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  510.   assembler;
  511. asm
  512.         { ->    EAX Pointer to Instance         }
  513.         {       EDX Pointer to prop info        }
  514.         { <-    AL  Function result             }
  515.  
  516.         MOV     ECX,[EDX].TPropInfo.StoredProc
  517.         TEST    ECX,0FFFFFF00H
  518.         JE      @@returnCL
  519.         CMP     [EDX].TPropInfo.StoredProc.Byte[3],0FEH
  520.         MOV     EDX,[EDX].TPropInfo.Index
  521.         JB      @@isStaticMethod
  522.         JA      @@isField
  523.  
  524.         {       the StoredProc is a virtual method }
  525.         MOVSX   ECX,CX                  { sign extend slot offs }
  526.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  527.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  528.         JMP     @@exit
  529.  
  530. @@isStaticMethod:
  531.         CALL    ECX
  532.         JMP     @@exit
  533.  
  534. @@isField:
  535.         AND     ECX,$00FFFFFF
  536.         MOV     CL,[EAX+ECX]
  537.  
  538. @@returnCL:
  539.         MOV     AL,CL
  540.  
  541. @@exit:
  542. end;
  543.  
  544. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  545.   assembler;
  546. asm
  547.         { ->    EAX Pointer to instance         }
  548.         {       EDX Pointer to property info    }
  549.         { <-    EAX Longint result              }
  550.  
  551.         PUSH    EBX
  552.         PUSH    EDI
  553.         MOV     EDI,[EDX].TPropInfo.PropType
  554.         MOV     BL,otSLong
  555.         CMP     [EDI].TTypeInfo.Kind,tkClass
  556.         JE      @@isClass
  557.         XOR     ECX,ECX
  558.         MOV     CL,[EDI].TTypeInfo.Name.Byte[0]
  559.         MOV     BL,[EDI].TTypeInfo.Name[ECX+1].TTypeData.OrdType
  560. @@isClass:
  561.         MOV     ECX,[EDX].TPropInfo.GetProc
  562.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  563.         MOV     EDX,[EDX].TPropInfo.Index
  564.         JB      @@isStaticMethod
  565.         JA      @@isField
  566.  
  567.         {       the GetProc is a virtual method }
  568.         MOVSX   ECX,CX                  { sign extend slot offs }
  569.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  570.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  571.         JMP     @@final
  572.  
  573. @@isStaticMethod:
  574.         CALL    ECX
  575.         JMP     @@final
  576.  
  577. @@isField:
  578.         AND     ECX,$00FFFFFF
  579.         ADD     ECX,EAX
  580.         MOV     AL,[ECX]
  581.         CMP     BL,otSWord
  582.         JB      @@final
  583.         MOV     AX,[ECX]
  584.         CMP     BL,otSLong
  585.         JB      @@final
  586.         MOV     EAX,[ECX]
  587. @@final:
  588.         CMP     BL,otSLong
  589.         JAE     @@exit
  590.         CMP     BL,otSWord
  591.         JAE     @@word
  592.         CMP     BL,otSByte
  593.         MOVSX   EAX,AL
  594.         JE      @@exit
  595.         AND     EAX,$FF
  596.         JMP     @@exit
  597. @@word:
  598.         MOVSX   EAX,AX
  599.         JE      @@exit
  600.         AND     EAX,$FFFF
  601. @@exit:
  602.         POP     EDI
  603.         POP     EBX
  604. end;
  605.  
  606. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  607.   Value: Longint); assembler;
  608. asm
  609.         { ->    EAX Pointer to instance         }
  610.         {       EDX Pointer to property info    }
  611.         {       ECX Value                       }
  612.  
  613.         PUSH    EBX
  614.         PUSH    ESI
  615.         PUSH    EDI
  616.         MOV     EDI,EDX
  617.  
  618.         MOV     ESI,[EDI].TPropInfo.PropType
  619.         MOV     BL,otSLong
  620.         CMP     [ESI].TTypeInfo.Kind,tkClass
  621.         JE      @@isClass
  622.         XOR     EBX,EBX
  623.         MOV     BL,[ESI].TTypeInfo.Name.Byte[0]
  624.         MOV     BL,[ESI].TTypeInfo.Name[EBX+1].TTypeData.OrdType
  625. @@isClass:
  626.         MOV     EDX,[EDI].TPropInfo.Index       { pass Index in DX      }
  627.         CMP     EDX,$80000000
  628.         JNE     @@hasIndex
  629.         MOV     EDX,ECX                         { pass value in EDX     }
  630. @@hasIndex:
  631.         MOV     ESI,[EDI].TPropInfo.SetProc
  632.         CMP     [EDI].TPropInfo.SetProc.Byte[3],$FE
  633.         JA      @@isField
  634.         JB      @@isStaticMethod
  635.  
  636.         {       SetProc turned out to be a virtual method. call it      }
  637.         MOVSX   ESI,SI                          { sign extend slot offset }
  638.         ADD     ESI,[EAX]                       { vmt   + slot offset   }
  639.         CALL    dword ptr [ESI]
  640.         JMP     @@exit
  641.  
  642. @@isStaticMethod:
  643.         CALL    ESI
  644.         JMP     @@exit
  645.  
  646. @@isField:
  647.         AND     ESI,$00FFFFFF
  648.         ADD     EAX,ESI
  649.         MOV     [EAX],CL
  650.         CMP     BL,otSWord
  651.         JB      @@exit
  652.         MOV     [EAX],CX
  653.         CMP     BL,otSLong
  654.         JB      @@exit
  655.         MOV     [EAX],ECX
  656. @@exit:
  657.         POP     EDI
  658.         POP     ESI
  659.         POP     EBX
  660. end;
  661.  
  662. procedure GetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  663.   var Value: ShortString); assembler;
  664. asm
  665.         { ->    EAX Pointer to instance         }
  666.         {       EDX Pointer to property info    }
  667.         {       ECX Pointer to result string    }
  668.  
  669.         PUSH    ESI
  670.         PUSH    EDI
  671.         MOV     EDI,EDX
  672.  
  673.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  674.         CMP     EDX,$80000000
  675.         JNE     @@hasIndex
  676.         MOV     EDX,ECX                         { pass value in EDX }
  677. @@hasIndex:
  678.         MOV     ESI,[EDI].TPropInfo.GetProc
  679.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  680.         JA      @@isField
  681.         JB      @@isStaticMethod
  682.  
  683.         {       GetProc turned out to be a virtual method       }
  684.         MOVSX   ESI,SI                          { sign extend slot offset}
  685.         ADD     ESI,[EAX]                       { vmt + slot offset     }
  686.         CALL    dword ptr [ESI]
  687.         JMP     @@exit
  688.  
  689. @@isStaticMethod:
  690.         CALL    ESI
  691.         JMP     @@exit
  692.  
  693. @@isField:
  694.         AND     ESI,$00FFFFFF
  695.         ADD     ESI,EAX
  696.         MOV     EDI,ECX
  697.         XOR     ECX,ECX
  698.         MOV     CL,[ESI]
  699.         INC     ECX
  700.         REP     MOVSB
  701.  
  702. @@exit:
  703.         POP     EDI
  704.         POP     ESI
  705. end;
  706.  
  707. procedure SetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  708.   const Value: ShortString); assembler;
  709. asm
  710.         { ->    EAX Pointer to instance         }
  711.         {       EDX Pointer to property info    }
  712.         {       ECX Pointer to string value     }
  713.  
  714.         PUSH    ESI
  715.         PUSH    EDI
  716.         MOV     ESI,EDX
  717.  
  718.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  719.         CMP     EDX,$80000000
  720.         JNE     @@hasIndex
  721.         MOV     EDX,ECX                         { pass value in EDX }
  722. @@hasIndex:
  723.         MOV     EDI,[ESI].TPropInfo.SetProc
  724.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  725.         JA      @@isField
  726.         JB      @@isStaticMethod
  727.  
  728.         {       SetProc is a virtual method }
  729.         MOVSX   EDI,DI
  730.         ADD     EDI,[EAX]
  731.         CALL    dword ptr [EDI]
  732.         JMP     @@exit
  733.  
  734. @@isStaticMethod:
  735.         CALL    EDI
  736.         JMP     @@exit
  737.  
  738. @@isField:
  739.         AND     EDI,$00FFFFFF
  740.         ADD     EDI,EAX
  741.         MOV     EAX,[ESI].TPropInfo.PropType
  742.         MOV     ESI,ECX
  743.         XOR     ECX,ECX
  744.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  745.         MOV     CL,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxLength
  746.  
  747.         LODSB
  748.         CMP     AL,CL
  749.         JB      @@noTruncate
  750.         MOV     AL,CL
  751. @@noTruncate:
  752.         STOSB
  753.         MOV     CL,AL
  754.         REP     MOVSB
  755. @@exit:
  756.         POP     EDI
  757.         POP     ESI
  758. end;
  759.  
  760. procedure AssignString(var Dest: string; const Source: string);
  761. begin
  762.   Dest := Source;
  763. end;
  764.  
  765. procedure GetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  766.   var Value: string); assembler;
  767. asm
  768.         { ->    EAX Pointer to instance         }
  769.         {       EDX Pointer to property info    }
  770.         {       ECX Pointer to result string    }
  771.  
  772.         PUSH    ESI
  773.         PUSH    EDI
  774.         MOV     EDI,EDX
  775.  
  776.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  777.         CMP     EDX,$80000000
  778.         JNE     @@hasIndex
  779.         MOV     EDX,ECX                         { pass value in EDX }
  780. @@hasIndex:
  781.         MOV     ESI,[EDI].TPropInfo.GetProc
  782.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  783.         JA      @@isField
  784.         JB      @@isStaticMethod
  785.  
  786. @@isVirtualMethod:
  787.         MOVSX   ESI,SI                          { sign extend slot offset }
  788.         ADD     ESI,[EAX]                       { vmt + slot offset }
  789.         CALL    DWORD PTR [ESI]
  790.         JMP     @@exit
  791.  
  792. @@isStaticMethod:
  793.         CALL    ESI
  794.         JMP     @@exit
  795.  
  796. @@isField:
  797.     AND    ESI,$00FFFFFF
  798.     MOV    EDX,[EAX+ESI]
  799.     MOV    EAX,ECX
  800.     CALL    AssignString
  801.  
  802. @@exit:
  803.         POP     EDI
  804.         POP     ESI
  805. end;
  806.  
  807. procedure SetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  808.   const Value: string); assembler;
  809. asm
  810.         { ->    EAX Pointer to instance         }
  811.         {       EDX Pointer to property info    }
  812.         {       ECX Pointer to string value     }
  813.  
  814.         PUSH    ESI
  815.         PUSH    EDI
  816.         MOV     ESI,EDX
  817.  
  818.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  819.         CMP     EDX,$80000000
  820.         JNE     @@hasIndex
  821.         MOV     EDX,ECX                         { pass value in EDX }
  822. @@hasIndex:
  823.         MOV     EDI,[ESI].TPropInfo.SetProc
  824.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  825.         JA      @@isField
  826.         JB      @@isStaticMethod
  827.  
  828. @@isVirtualMethod:
  829.         MOVSX   EDI,DI
  830.         ADD     EDI,[EAX]
  831.         CALL    DWORD PTR [EDI]
  832.         JMP     @@exit
  833.  
  834. @@isStaticMethod:
  835.         CALL    EDI
  836.         JMP     @@exit
  837.  
  838. @@isField:
  839.     AND    EDI,$00FFFFFF
  840.     ADD    EAX,EDI
  841.     MOV    EDX,ECX
  842.     CALL    AssignString
  843.  
  844. @@exit:
  845.         POP     EDI
  846.         POP     ESI
  847. end;
  848.  
  849. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  850. var
  851.   Temp: ShortString;
  852. begin
  853.   if PropInfo^.PropType^.Kind = tkString then
  854.   begin
  855.     GetShortStrProp(Instance, PropInfo, Temp);
  856.     Result := Temp;
  857.   end else
  858.     GetLongStrProp(Instance, PropInfo, Result);
  859. end;
  860.  
  861. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  862.   const Value: string);
  863. var
  864.   Temp: ShortString;
  865. begin
  866.   if PropInfo^.PropType^.Kind = tkString then
  867.   begin
  868.     Temp := Value;
  869.     SetShortStrProp(Instance, PropInfo, Temp);
  870.   end else
  871.     SetLongStrProp(Instance, PropInfo, Value);
  872. end;
  873.  
  874. const
  875.   C10000: Single = 10000;
  876.  
  877. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  878.   assembler;
  879. asm
  880.         { ->    EAX Pointer to instance         }
  881.         {       EDX Pointer to property info    }
  882.         { <-    FST(0) Extended result          }
  883.  
  884.         MOV     ECX,[EDX].TPropInfo.GetProc
  885.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  886.         JA      @@isField
  887.         JE      @@isVirtualMethod
  888.  
  889.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  890.         CALL    ECX
  891.         JMP     @@exit
  892.  
  893. @@isVirtualMethod:
  894.         MOVSX   ECX,CX
  895.         ADD     ECX,[EAX]
  896.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  897.         CALL    dword ptr [ECX]
  898.         JMP     @@exit
  899.  
  900. @@jmpTab:
  901.         DD      @@single,@@double,@@extended,@@comp,@@curr
  902.  
  903. @@single:
  904.         FLD     [EAX].Single
  905.         RET
  906.  
  907. @@double:
  908.         FLD     [EAX].Double
  909.         RET
  910.  
  911. @@extended:
  912.         FLD     [EAX].Extended
  913.         RET
  914.  
  915. @@comp:
  916.         FILD    [EAX].Comp
  917.         RET
  918.  
  919. @@curr:
  920.         FILD    [EAX].Currency
  921.         FDIV    C10000
  922.         RET
  923.  
  924. @@isField:
  925.         AND     ECX,$00FFFFFF
  926.         ADD     EAX,ECX
  927.         MOV     ECX,[EDX].TPropInfo.PropType
  928.         XOR     EDX,EDX
  929.         MOV     DL,[ECX].TTypeInfo.Name.Byte[0]
  930.         MOV     DL,[ECX].TTypeInfo.Name[EDX+1].TTypeData.FloatType
  931.  
  932.         CALL    dword ptr @@jmpTab[EDX*4]
  933.  
  934. @@exit:
  935.  
  936. end;
  937.  
  938. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  939.   Value: Extended); assembler;
  940. asm
  941.         { ->    EAX Pointer to instance         }
  942.         {       EDX Pointer to property info    }
  943.         {       Stack: Value                    }
  944.  
  945.         PUSH    EBX
  946.         PUSH    ESI
  947.  
  948.         XOR     EBX,EBX
  949.         MOV     ECX,[EDX].TPropInfo.PropType
  950.         MOV     BL,[ECX].TTypeInfo.Name.Byte[0]
  951.         MOV     BL,[ECX].TTypeInfo.Name[EBX+1].TTypeData.FloatType
  952.         SHL     EBX,2
  953.         FLD     Value
  954.         MOV     ECX,[EDX].TPropInfo.SetProc
  955.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  956.         JA      @@isField
  957.         SUB     ESP,dword ptr @@sizTab[EBX]
  958.         MOV     ESI,ESP
  959.         CALL    dword ptr @@storeProc[EBX]
  960.  
  961.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  962.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  963.         JB      @@isStaticMethod
  964.  
  965.         MOVSX   ECX,CX
  966.         ADD     ECX,[EAX]
  967.         CALL    dword ptr [ECX]
  968.         JMP     @@exit
  969.  
  970. @@isStaticMethod:
  971.         CALL    ECX
  972.         JMP     @@exit
  973.  
  974. @@sizTab:
  975.         DD      4,8,12,8,8
  976.  
  977. @@storeProc:
  978.         DD      @@single,@@double,@@extended,@@comp,@@curr
  979.  
  980. @@single:
  981.         FSTP    [ESI].Single
  982.         RET
  983.  
  984. @@double:
  985.         FSTP    [ESI].Double
  986.         RET
  987.  
  988. @@extended:
  989.         FSTP    [ESI].Extended
  990.         RET
  991.  
  992. @@comp:
  993.         FISTP   [ESI].Comp
  994.         RET
  995.  
  996. @@curr:
  997.         FMUL    C10000
  998.         FISTP   [ESI].Currency
  999.         RET
  1000.  
  1001. @@isField:
  1002.         AND     ECX,$00FFFFFF
  1003.         LEA     ESI,[EAX+ECX]
  1004.         CALL    dword ptr @@storeProc[EBX]
  1005.  
  1006. @@exit:
  1007.         POP     ESI
  1008.         POP     EBX
  1009. end;
  1010.  
  1011. procedure AssignVariant(var Dest: Variant; const Source: Variant);
  1012. begin
  1013.   Dest := Source;
  1014. end;
  1015.  
  1016. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  1017. asm
  1018.         { ->    EAX Pointer to instance         }
  1019.         {       EDX Pointer to property info    }
  1020.         {       ECX Pointer to result variant   }
  1021.  
  1022.         PUSH    ESI
  1023.         PUSH    EDI
  1024.         MOV     EDI,EDX
  1025.  
  1026.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1027.         CMP     EDX,$80000000
  1028.         JNE     @@hasIndex
  1029.         MOV     EDX,ECX                         { pass value in EDX }
  1030. @@hasIndex:
  1031.         MOV     ESI,[EDI].TPropInfo.GetProc
  1032.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1033.         JA      @@isField
  1034.         JB      @@isStaticMethod
  1035.  
  1036. @@isVirtualMethod:
  1037.         MOVSX   ESI,SI                          { sign extend slot offset }
  1038.         ADD     ESI,[EAX]                       { vmt + slot offset }
  1039.         CALL    DWORD PTR [ESI]
  1040.         JMP     @@exit
  1041.  
  1042. @@isStaticMethod:
  1043.         CALL    ESI
  1044.         JMP     @@exit
  1045.  
  1046. @@isField:
  1047.     AND    ESI,$00FFFFFF
  1048.     LEA    EDX,[EAX+ESI]
  1049.     MOV    EAX,ECX
  1050.     CALL    AssignVariant
  1051.  
  1052. @@exit:
  1053.         POP     EDI
  1054.         POP     ESI
  1055. end;
  1056.  
  1057. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  1058.   const Value: Variant);
  1059. asm
  1060.         { ->    EAX Pointer to instance         }
  1061.         {       EDX Pointer to property info    }
  1062.         {       ECX Pointer to variant value    }
  1063.  
  1064.         PUSH    ESI
  1065.         PUSH    EDI
  1066.         MOV     ESI,EDX
  1067.  
  1068.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1069.         CMP     EDX,$80000000
  1070.         JNE     @@hasIndex
  1071.         MOV     EDX,ECX                         { pass value in EDX }
  1072. @@hasIndex:
  1073.         MOV     EDI,[ESI].TPropInfo.SetProc
  1074.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1075.         JA      @@isField
  1076.         JB      @@isStaticMethod
  1077.  
  1078. @@isVirtualMethod:
  1079.         MOVSX   EDI,DI
  1080.         ADD     EDI,[EAX]
  1081.         CALL    DWORD PTR [EDI]
  1082.         JMP     @@exit
  1083.  
  1084. @@isStaticMethod:
  1085.         CALL    EDI
  1086.         JMP     @@exit
  1087.  
  1088. @@isField:
  1089.     AND    EDI,$00FFFFFF
  1090.     ADD    EAX,EDI
  1091.     MOV    EDX,ECX
  1092.     CALL    AssignVariant
  1093.  
  1094. @@exit:
  1095.         POP     EDI
  1096.         POP     ESI
  1097. end;
  1098.  
  1099. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  1100.   assembler;
  1101. asm
  1102.         { ->    EAX Pointer to instance         }
  1103.         {       EDX Pointer to property info    }
  1104.         {       ECX Pointer to result           }
  1105.  
  1106.         PUSH    EBX
  1107.         PUSH    ESI
  1108.         MOV     ESI,EDX
  1109.  
  1110.         MOV     EDX,[ESI].TPropInfo.Index       { pass Index in DX      }
  1111.         CMP     EDX,$80000000
  1112.         JNE     @@hasIndex
  1113.         MOV     EDX,ECX                         { pass value in EDX     }
  1114. @@hasIndex:
  1115.  
  1116.         MOV     EBX,[ESI].TPropInfo.GetProc
  1117.         CMP     [ESI].TPropInfo.GetProc.Byte[3],$FE
  1118.         JA      @@isField
  1119.         JB      @@isStaticMethod
  1120.  
  1121.         {       GetProc is a virtual method     }
  1122.         MOVSX   EBX,BX                          { sign extend slot number }
  1123.         ADD     EBX,[EAX]
  1124.         CALL    dword ptr [EBX]
  1125.         JMP     @@exit
  1126.  
  1127. @@isStaticMethod:
  1128.         CALL    EBX
  1129.         JMP     @@exit
  1130.  
  1131. @@isField:
  1132.         AND     EBX,$00FFFFFF
  1133.         ADD     EAX,EBX
  1134.         MOV     EDX,[EAX]
  1135.         MOV     EBX,[EAX+4]
  1136.         MOV     [ECX],EDX
  1137.         MOV     [ECX+4],EBX
  1138.  
  1139. @@exit:
  1140.         POP     ESI
  1141.         POP     EBX
  1142. end;
  1143.  
  1144. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  1145.   const Value: TMethod); assembler;
  1146. asm
  1147.         { ->    EAX Pointer to instance         }
  1148.         {       EDX Pointer to property info    }
  1149.         {       ECX Pointer to value            }
  1150.         PUSH    EBX
  1151.         MOV     EBX,[EDX].TPropInfo.SetProc
  1152.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1153.         JA      @@isField
  1154.         MOV     EDX,[EDX].TPropInfo.Index
  1155.         PUSH    dword ptr [ECX+4]
  1156.         PUSH    dword ptr [ECX]
  1157.         JB      @@isStaticMethod
  1158.  
  1159.         {       SetProc is a virtual method     }
  1160.         MOVSX   EBX,BX
  1161.         ADD     EBX,[EAX]
  1162.         CALL    dword ptr [EBX]
  1163.         JMP     @@exit
  1164.  
  1165. @@isStaticMethod:
  1166.         CALL    EBX
  1167.         JMP     @@exit
  1168.  
  1169. @@isField:
  1170.         AND     EBX,$00FFFFFF
  1171.         ADD     EAX,EBX
  1172.         MOV     EDX,[ECX]
  1173.         MOV     EBX,[ECX+4]
  1174.         MOV     [EAX],EDX
  1175.         MOV     [EAX+4],EBX
  1176.  
  1177. @@exit:
  1178.         POP     EBX
  1179. end;
  1180.  
  1181. end.
  1182.