?? objautox.pas
字號(hào):
{*******************************************************}
{ CodeGear Delphi Runtime Library }
{ Delphi Reflection Unit }
{ Work likes Java & C# }
{ Copyright(c) 2008 Rarnu }
{*******************************************************}
unit ObjAutoX;
interface
uses TypInfo;
{$IFDEF VER130}
Not Support Delphi 5
{$ENDIF}
{$IFDEF VER120}
Not Support Delphi 4
{$ENDIF}
{$IFDEF VER100}
Not Support Delphi 3
{$ENDIF}
{$IFDEF VER90}
Not Support Delphi 2
{$ENDIF}
{$IFDEF VER80}
Not Support Delphi 1
{$ENDIF}
{$IFDEF VER200}
{$DEFINE DELPHI2009}
{$ENDIF}
const
paEAX = word(0);
paEDX = word(1);
paECX = word(2);
paStack = word(3);
SHORT_LEN = SizeOf(ShortString) - 1;
type
TCallingConvention = (ccRegister, ccCdecl, ccPascal, ccStdCall, ccSafeCall);
TParamFlags = set of (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut,
pfResult);
PPointer = ^Pointer;
PWord = ^word;
PMethodInfoHeader = ^TMethodInfoHeader;
TMethodInfoHeader = packed record
Len: word;
Addr: Pointer;
Name: ShortString;
end;
PPropertyInfo = PPropInfo;
PReturnInfo = ^TReturnInfo;
TReturnInfo = packed record
Version: byte; // Must be 1
CallingConvention: TCallingConvention;
ReturnType: ^PTypeInfo;
ParamSize: word;
end;
PParamInfo = ^TParamInfo;
TParamInfo = packed record
Flags: TParamFlags;
ParamType: ^PTypeInfo;
Access: word;
Name: ShortString;
end;
TMethodInfoArray = array of PMethodInfoHeader;
TParamInfoArray = array of PParamInfo;
TPropertyArray = array of PPropertyInfo;
// 動(dòng)態(tài)調(diào)用方法
// 參數(shù)：
// Instance: 類實(shí)例
// MethodHeader: 類內(nèi)方法 $MethodInfo 信息
// ParamIndexes: 參數(shù)索引
// Params: 參數(shù)表
// Return: 被調(diào)用方法的返回值
function ObjectInvoke(Instance: TObject; MethodHeader: PMethodInfoHeader;
const ParamIndexes: array of integer; const Params: array of variant): variant;
// 獲取方法 $MethodInfo 信息
// 參數(shù)：
// Instance: 類實(shí)例
// MethodName: 方法名
// Return: 類內(nèi)方法 $MethodInfo 信息
function GetMethodInfo(Instance: TObject;
const MethodName: ShortString): PMethodInfoHeader;
type
IMethodHandler = interface
['{4E61C8CD-16CC-4830-B1E4-84F86FBC0D23}']
function Execute(const Args: array of variant): variant;
function InstanceToVariant(Instance: TObject): variant;
end;
PParameters = ^TParameters;
TParameters = packed record
Registers: array[paEDX..paECX] of cardinal;
Stack: array[0..1023] of byte;
end;
TDynamicInvokeEvent = procedure(Params: PParameters; StackSize: integer) of object;
// 建立代碼委托智能指針(重載)
// 參數(shù)：
// MethodHandler: 方法句柄接口
// TypeData: 方法 $TypeData 信息
// Return: 方法指針
function CreateMethodPointer(const MethodHandler: IMethodHandler;
TypeData: PTypeData): TMethod; overload;
// 建立代碼委托智能指針(重載)
// 參數(shù)：
// ADynamicInvokeEvent: 方法調(diào)用事件函數(shù)對(duì)象
// TypeData: 方法 $TypeData 信息
// Return: 方法指針
function CreateMethodPointer(const ADynamicInvokeEvent: TDynamicInvokeEvent;
TypeData: PTypeData): TMethod; overload;
// 釋放代碼委托智能指針
// 參數(shù)：
// Method: 方法指針
procedure ReleaseMethodPointer(MethodPointer: TMethod);
// 獲取方法列表
// 參數(shù)：
// ClassType: 類TypeInfo信息
// Return: 類內(nèi)方法 $MethodInfo 列表
function GetMethods(ClassType: TClass): TMethodInfoArray;
function GetInvokeInstance(MethodPointer: TMethod): TObject;
// 獲取參數(shù)列表
// 參數(shù)：
// Instance: 類實(shí)例
// MethodName: 方法名
// Return: 類內(nèi)方法參數(shù) $MethodInfo 列表
function GetParams(Instance: TObject; MethodName: string): TParamInfoArray;
// 獲取返回值信息
// 參數(shù)：
// Instance: 類實(shí)例
// MethodName: 方法名
// Return: 類內(nèi)方法返回值 $MethodInfo 信息
function GetReturnInfo(Instance: TObject; MethodName: string): PReturnInfo;
// 獲取屬性列表
// 參數(shù)：
// ClassType: 類TypeInfo信息
// Return: 類內(nèi)公開(kāi)屬性 $M 列表
function GetProperties(ClassType: TClass): TPropertyArray;
implementation
uses SysUtils, Variants, VarUtils, RTLConsts;
function GetProperties(ClassType: TClass): TPropertyArray;
var
ClassTypeInfo: PTypeInfo;
ClassDataInfo: PTypeData;
Pplst: PPropList;
i: integer;
begin
ClassTypeInfo := ClassType.ClassInfo;
ClassDataInfo := GetTypeData(ClassTypeInfo);
if ClassDataInfo.PropCount <> 0 then
begin
GetMem(Pplst, sizeof(PPropInfo) * ClassDataInfo.PropCount);
try
GetPropInfos(ClassTypeInfo, Pplst);
SetLength(Result, ClassDataInfo.PropCount);
for i := 0 to ClassDataInfo.PropCount - 1 do
begin
Result[i] := Pplst[i];
end;
finally
FreeMem(Pplst, sizeof(PPropInfo) * ClassDataInfo.PropCount);
end;
end;
end;
function GetTypeSize(TypeInfo: PTypeInfo): integer;
var
TypeData: PTypeData;
begin
case TypeInfo^.Kind of
tkInteger, tkEnumeration:
begin
TypeData := GetTypeData(TypeInfo);
if TypeData^.MinValue >= 0 then
if cardinal(TypeData^.MaxValue) > $FFFF then
Result := 4
else if TypeData^.MaxValue > $FF then
Result := 2
else
Result := 1
else
if (TypeData^.MaxValue > $7FFF) or (TypeData^.MinValue < -$7FFF - 1) then
Result := 4
else if (TypeData^.MaxValue > $7F) or (TypeData^.MinValue < -$7F - 1) then
Result := 2
else
Result := 1;
end;
tkFloat:
begin
TypeData := GetTypeData(TypeInfo);
case TypeData^.FloatType of
ftSingle: Result := 4;
ftComp, ftCurr, ftDouble: Result := 8;
else
Result := -1;
end;
end;
tkString, tkLString,
{$IFDEF DELPHI2009}
tkUString,
{$ENDIF}
tkWString, tkInterface, tkClass:
Result := 4;
tkMethod, tkInt64:
Result := 8;
tkVariant:
Result := 16;
else
Assert(False);
Result := -1;
end;
end;
type
TConvertKind = (ckNone, ckConvert, ckError);
function ConvertKindOf(Source, Dest: TVarType): TConvertKind;
const
none = ckNone;
cvt = ckConvert;
err = ckError;
Codes: array[varEmpty..
{$IFDEF DELPHI2009}
varUInt64
{$ELSE}varInt64{$ENDIF}
, varEmpty..
{$IFDEF DELPHI2009}
varUInt64
{$ELSE}varInt64{$ENDIF}
] of TConvertKind =
({v From} {To >}{vt_empty} {vt_null} {vt_i2} {vt_i4} {vt_r4}
{vt_r8}{vt_cy}{vt_date}{vt_bstr}{vt_dispatch}{vt_error}{vt_bool}
{vt_variant}{vt_unknown}{vt_decimal}{0x0f }{vt_i1}{vt_ui1}
{vt_ui2}{vt_ui4}{vt_i8}{vt_ui8}
{vt_empty} (none, err, err, err, err, err,
err, err, err, err, err, err, none,
err, err, err, err, err, err, err, err
{$IFDEF DELPHI2009}
, err
{$ENDIF}
),
{vt_null} (err, none, err, err, err, err,
err, err, err, err, err, err, none,
err, err, err, err, err, err, err, err
{$IFDEF DELPHI2009}
, err
{$ENDIF}
),
{vt_i2} (err, err, none, cvt, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_i4} (err, err, none, none, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_r4} (err, err, cvt, cvt, none, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_r8} (err, err, cvt, cvt, cvt, none,
none, none, cvt, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_cy} (err, err, cvt, cvt, cvt, none,
none, none, cvt, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_date} (err, err, cvt, cvt, cvt, none,
none, none, cvt, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_bstr} (err, err, cvt, cvt, cvt, cvt,
cvt, cvt, none, err, err, cvt, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_dispatch} (err, err, err, err, err, err,
err, err, err, none, err, err, none,
none, err, err, err, err, err, err, err
{$IFDEF DELPHI2009}
, err
{$ENDIF}
),
{vt_error} (err, err, err, err, err, err,
err, err, err, err, none, err, none,
err, err, err, err, err, err, err, err
{$IFDEF DELPHI2009}
, err
{$ENDIF}
),
{vt_bool} (err, err, cvt, cvt, err, err,
err, err, cvt, err, err, none, none,
err, cvt, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_variant} (cvt, cvt, cvt, cvt, cvt, cvt,
cvt, cvt, cvt, cvt, cvt, cvt, none,
cvt, cvt, cvt, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_unknown} (err, err, err, err, err, err,
err, err, err, err, err, err, none,
none, err, err, err, err, err, err, err
{$IFDEF DELPHI2009}
, err
{$ENDIF}
),
{vt_decimal} (err, err, cvt, cvt, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, none, err, cvt, cvt, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{0x0f } (err, err, err, err, err, err,
err, err, err, err, err, err, none,
err, err, none, err, err, err, err, err
{$IFDEF DELPHI2009}
, err
{$ENDIF}
),
{vt_i1} (err, err, cvt, cvt, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, none, none, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_ui1} (err, err, cvt, cvt, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, none, none, cvt, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_ui2} (err, err, none, cvt, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, none, none, none, cvt, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_ui4} (err, err, none, none, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, none, none, none, none, cvt
{$IFDEF DELPHI2009}
, cvt
{$ENDIF}
),
{vt_i8} (err, err, none, none, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, none, none, none, none, none
{$IFDEF DELPHI2009}
, none
{$ENDIF}
)
{$IFDEF DELPHI2009}
{vt_ui8}, (err, err, none, none, cvt, cvt,
cvt, cvt, cvt, err, err, cvt, none,
err, cvt, err, none, none, none,
none, none, none)
{$ENDIF}
);
begin
if Source = Dest then
Result := none
else
// < Low(Codes) always evaluates to false since it is zero
if {(Source < Low(Codes)) or} (Source > High(Codes)) or
{(Dest < Low(Codes)) or} (Dest > High(Codes)) then
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -