mit string an PTypeinfo rankommen

[_frank_]

Mit der normalen RTTI ist das wohl nicht möglich?

habs mal so probiert:

Delphi-Quellcode:

//longword => integer

function FindTypeInfo(const ATypeName: string): PTypeInfo;

type
  TEnumTypeInfoFunc = function(AUserData: Pointer; ATypeInfo: PTypeInfo): Boolean; register;

  //findtypeinfo

function EnumTypeInfos_base(AModule: integer; AFunc: TEnumTypeInfoFunc; AUserData: Pointer): PTypeInfo;
// copyright (c) 1998 Hagen Reddmann

  function GetBaseOfCode(AModule: integer; var ACodeStart, ACodeEnd: PChar): Boolean; register;
  // get Codesegment pointers, check if module is a valid PE
  asm
           PUSH  EDI
           PUSH  ESI
           AND   EAX,not 3
           JZ    @@2
           CMP   Word Ptr [EAX],'ZM';
           JNE   @@1
           MOV   ESI,[EAX + 03Ch]
           CMP   Word Ptr [ESI + EAX],'EP'
           JNE   @@1
           MOV   EDI,[EAX + ESI + 014h + 008h]
           ADD   EAX,[EAX + ESI + 014h + 018h]
           ADD   EDI,EAX
           MOV   [EDX],EAX
           MOV   [ECX],EDI
           XOR   EAX,EAX
    @@1:   SETE  AL
    @@2:   POP   ESI
           POP   EDI
  end;

type
  PLongWord = ^integer;
  PByte = ^Byte;
var
  P,E,K,N: PChar;
  L: Integer;
begin
  Result := nil;
  try
    if GetBaseOfCode(AModule, P, E) then
      while P < E do
      begin
        integer(P) := integer(P) and not 3;
        K := P + 4;
        if (PLongWord(P)^ = integer(K)) and (TTypeKind(K^) >= Low(TTypeKind)) and (TTypeKind(K^) <= High(TTypeKind)) then
        begin
          L := PByte(K + 1)^;  // length Info.Name
          N := K + 2;          // @Info.Name[1]
          if (L > 0) and (N^ in ['_', 'a'..'z', 'A'..'Z']) then  // valid ident ??
          begin
            repeat
              Inc(N);
              Dec(L);
            until (L = 0) or not (N^ in ['_', 'a'..'z', 'A'..'Z', '0'..'9']);
            if L = 0 then // length and ident valid
              if not Assigned(AFunc) or AFunc(AUserData, Pointer(K)) then // tell it and if needed abort iteration
              begin
                Result := Pointer(K);
                Exit;
              end else K := N;
          end;
        end;
        P := K;
      end;
  except
  end;
end;

function EnumTypeInfos(AFunc: TEnumTypeInfoFunc; AUserData: Pointer): PTypeInfo;
type
  PModulesEnumData = ^TModulesEnumData;
  TModulesEnumData = packed record
    AFunc: TEnumTypeInfoFunc;
    AUserData: Pointer;
    AResult: PTypeInfo;
  end;

  function EnumTypeInfosInModule(AModule: integer; AData: PModulesEnumData): Boolean; register;
  begin
    with AData^ do
    begin
      AResult := EnumTypeInfos_base(AModule, AFunc, AUserData);
      Result := AResult = nil;
    end;
  end;

var
  Data: TModulesEnumData;
begin
  Data.AFunc := AFunc;
  Data.AUserData := AUserData;
  Data.AResult := nil;
  EnumModules(TEnumModuleFunc(@EnumTypeInfosInModule), @Data);
  Result := Data.AResult;
end;

function IsTypeCorrespondingToName(AName: Pointer; ATypeInfo: PTypeInfo): Boolean; register;
begin
  Result := AnsiCompareText(PChar(AName), ATypeInfo.Name) = 0;
end;

function FindTypeInfo(const ATypeName: string): PTypeInfo;
begin
  Result := EnumTypeInfos(IsTypeCorrespondingToName, PChar(ATypeName));
end;

leider ist z.B. FindTypeInfo('TBorderIcon') = nil
sollte abr nicht so sein

Gruß Frank