Einzelnen Beitrag anzeigen

Benutzerbild von _frank_
_frank_

Registriert seit: 21. Feb 2003
Ort: Plauen / Bamberg
922 Beiträge
 
Delphi 3 Professional
 
#7

Re: mit string an PTypeinfo rankommen

  Alt 27. Apr 2006, 14:49
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
Frank Wunderlich
  Mit Zitat antworten Zitat