//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;