(* * InstantObjects * RTTI Interface *) (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is: Seleqt InstantObjects * * The Initial Developer of the Original Code is: Seleqt * * Portions created by the Initial Developer are Copyright (C) 2001-2003 * the Initial Developer. All Rights Reserved. * * Contributor(s): * Carlo Barazzetta, Adrea Petrelli, Uberto Barbini, Nando Dessena * * ***** END LICENSE BLOCK ***** *) unit InstantRtti; {$IFDEF LINUX} {$I '../InstantDefines.inc'} {$ELSE} {$I '../InstantDefines.inc'} {$ENDIF} interface uses Classes, TypInfo; type TInstantProperties = class(TObject) private FInstance: TObject; FClass: TClass; FPropCount: Integer; FPropList: PPropList; procedure CreatePropList(TypeInfo: PTypeInfo); procedure DestroyPropList; function GetCount: Integer; function GetPropInfos(Index: Integer): PPropInfo; function GetNames(Index: Integer): string; function GetTexts(Index: Integer): string; function GetTypes(Index: Integer): TTypeKind; function GetValues(Index: Integer): Variant; public constructor Create(AInstance: TObject); overload; constructor Create(AClass: TClass; AInstance: TObject = nil); overload; destructor Destroy; override; property Count: Integer read GetCount; property Names[Index: Integer]: string read GetNames; property PropInfos[Index: Integer]: PPropInfo read GetPropInfos; property Texts[Index: Integer]: string read GetTexts; property Types[Index: Integer]: TTypeKind read GetTypes; property Values[Index: Integer]: Variant read GetValues; end; function GetTypeInfo(PropInfo: PPropInfo) : PTypeInfo; procedure InstantGetEnumNames(TypeInfo: PTypeInfo; Names: TStrings; PrefixLen: Integer = 0); function InstantGetProperty(AObject: TObject; PropPath: string): Variant; function InstantGetPropInfo(AClass: TClass; PropPath: string; PInstance: Pointer = nil): PPropInfo; procedure InstantSetProperty(AObject: TObject; PropPath: string; Value: Variant); function InstantIsDefaultPropertyValue(Instance: TObject; PropInfo: PPropInfo): Boolean; implementation uses {$IFDEF MSWINDOWS} // Controls, {$ENDIF} {$IFDEF LINUX} InstantClasses, //only for TDate and TTime declaration QControls, {$ENDIF} {$IFDEF D6+}Variants,{$ENDIF}SysUtils; function GetTypeInfo(PropInfo: PPropInfo) : PTypeInfo; begin {$IFDEF FPC} Result := PropInfo^.PropType; {$ELSE} Result := PropInfo^.PropType^; {$ENDIF} end; function AccessProperty(AObject: TObject; PropPath: string; Value: Variant): Variant; var PropInfo: PPropInfo; begin if Assigned(AObject) then begin if SameText(PropPath, 'Self') then begin Result := Integer(AObject); Exit; end; PropInfo := InstantGetPropInfo(AObject.ClassType, PropPath, @AObject); if not Assigned(AObject) then VarClear(Result) else if Assigned(PropInfo) then begin if not VarIsNull(Value) and Assigned(PropInfo.SetProc) then begin case GetTypeInfo(PropInfo)^.Kind of tkClass: SetObjectProp(AObject, PropInfo, TObject(Integer(Value))); tkEnumeration: begin {$IFDEF D6+} if VarIsStr(Value) and (VarToStr(Value) = '') then Value := 0; {$ELSE} case VarType(Value) of varString : if VarToStr(Value) = '' then Value := 0; varBoolean: if (VarToStr(Value) <> '0') then Value := 1; end; {$ENDIF} SetPropValue(AObject, PropInfo^.Name, Value); end; tkSet: if VarToStr(Value) = '' then SetPropValue(AObject, PropInfo^.Name, '[]') else SetPropValue(AObject, PropInfo^.Name, Value); else SetPropValue(AObject, PropInfo^.Name, Value); end; end; Result := GetPropValue(AObject, PropInfo^.Name); end else Result := Null; end else VarClear(Result); end; procedure InstantGetEnumNames(TypeInfo: PTypeInfo; Names: TStrings; PrefixLen: Integer); var TypeData: PTypeData; I: Integer; S: string; begin TypeData := GetTypeData(TypeInfo); Names.BeginUpdate; try Names.Clear; for I := TypeData^.MinValue to TypeData^.MaxValue do begin S := GetEnumName(TypeInfo, I); Delete(S, 1, PrefixLen); Names.Add(S); end; finally Names.EndUpdate; end; end; function InstantGetProperty(AObject: TObject; PropPath: string): Variant; begin Result := AccessProperty(AObject, PropPath, Null); end; function InstantGetPropInfo(AClass: TClass; PropPath: string; PInstance: Pointer): PPropInfo; var FirstDot: Integer; PropName: string; PropInfo: PPropInfo; TypeData: PTypeData; begin if Assigned(AClass) then begin FirstDot := Pos('.', PropPath); if FirstDot = 0 then Result := GetPropInfo(AClass, PropPath) else begin PropName := Copy(PropPath, 1, FirstDot - 1); System.Delete(PropPath, 1, FirstDot); PropInfo := GetPropInfo(AClass, PropName); if Assigned(PropInfo) and (PropInfo^.PropType^.Kind = tkClass) then begin if Assigned(PInstance) and Assigned(TObject(PInstance^)) then TObject(PInstance^) := GetObjectProp(TObject(PInstance^), PropInfo); TypeData := GetTypeData(GetTypeInfo(PropInfo)); if Assigned(TypeData) then Result := InstantGetPropInfo(TypeData.ClassType, PropPath, PInstance) else Result := nil; end else Result := nil; end; end else Result := nil; end; procedure InstantSetProperty(AObject: TObject; PropPath: string; Value: Variant); begin AccessProperty(AObject, PropPath, Value); end; function InstantIsDefaultPropertyValue(Instance: TObject; PropInfo: PPropInfo): Boolean; function IsDefaultOrdProp: Boolean; var Value: Longint; Default: Longint; begin Value := GetOrdProp(Instance, PropInfo); Default := PropInfo.Default; Result := (Default <> Longint($80000000)) and (Value = Default); end; function IsDefaultFloatProp: Boolean; var Value: Extended; begin Value := GetFloatProp(Instance, PropInfo); Result := Value = 0; end; function IsDefaultInt64Prop: Boolean; var Value: Int64; begin Value := GetInt64Prop(Instance, PropInfo); Result := Value = 0; end; {$IFDEF VER140} function IsDefaultStrProp: Boolean; var Value: WideString; begin Value := GetWideStrProp(Instance, PropInfo); Result := Value = ''; end; {$ELSE} function IsDefaultStrProp: Boolean; var Value: string; begin Value := GetStrProp(Instance, PropInfo); Result := Value = ''; end; {$ENDIF} function IsDefaultVariantProp: Boolean; var Value: Variant; begin Value := GetVariantProp(Instance, PropInfo); {$IFDEF VER140} Result := VarIsClear(Value); {$ELSE} Result := VarIsEmpty(Value); {$ENDIF} end; begin case PropInfo.PropType^.Kind of tkInteger, tkChar, tkEnumeration, tkSet: Result := IsDefaultOrdProp; tkFloat: Result := IsDefaultFloatProp; tkString, tkLString, tkWString: Result := IsDefaultStrProp; tkVariant: Result := IsDefaultVariantProp; tkInt64: Result := IsDefaultInt64Prop; else Result := False; end; end; { TInstantProperties } constructor TInstantProperties.Create(AInstance: TObject); begin FInstance := AInstance; if Assigned(FInstance) then CreatePropList(FInstance.ClassInfo); end; constructor TInstantProperties.Create(AClass: TClass; AInstance: TObject); begin FClass := AClass; FInstance := AInstance; if Assigned(FClass) then CreatePropList(FClass.ClassInfo); end; procedure TInstantProperties.CreatePropList(TypeInfo: PTypeInfo); const TypeKinds = [tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkWChar, tkLString, tkWString, {$IFDEF FPC} tkAString, tkBool, {$ENDIF} tkVariant, tkArray, tkRecord, tkInt64, tkDynArray]; begin DestroyPropList; if Assigned(TypeInfo) then begin FPropCount := GetPropList(TypeInfo, TypeKinds, nil); if FPropCount > 0 then begin GetMem(FPropList, FPropCount * SizeOf(Pointer)); try GetPropList(TypeInfo, TypeKinds, FPropList); except FreeMem(FPropList, FPropCount * SizeOf(Pointer)); raise; end; end; end; end; destructor TInstantProperties.Destroy; begin inherited; DestroyPropList; end; procedure TInstantProperties.DestroyPropList; begin if Assigned(FPropList) then begin FreeMem(FPropList, FPropCount * SizeOf(Pointer)); FPropList := nil; FPropCount := 0; end; end; function TInstantProperties.GetCount: Integer; begin Result := FPropCount; end; function TInstantProperties.GetNames(Index: Integer): string; begin Result := PropInfos[Index]^.Name; end; function TInstantProperties.GetPropInfos(Index: Integer): PPropInfo; begin if (Index < 0) or (Index >= FPropCount) then raise Exception.CreateFmt('%s: Index out of range', [ClassName]); Result := FPropList^[Index]; end; function TInstantProperties.GetTexts(Index: Integer): string; var Value: Variant; Time: TDateTime; begin if not Assigned(FInstance) then raise Exception.CreateFmt('%s: Instance unassigned', [ClassName]); case Types[Index] of tkString, tkLString, tkWString: Result := '''' + GetStrProp(FInstance, PropInfos[Index]) + ''''; else Value := Values[Index]; case VarType(Value) of VarDate: begin Time := VarToDateTime(Value); if Time = 0 then Result := '' else if Time < 1 then Result := TimeToStr(Time) else Result := DateTimeToStr(Time); end; else Result := VarToStr(Value); end; end; end; function TInstantProperties.GetTypes(Index: Integer): TTypeKind; begin Result := PropInfos[Index]^.PropType^.Kind; end; function TInstantProperties.GetValues(Index: Integer): Variant; var PropInfo: PPropInfo; Value: Double; CurrencyValue : Currency; begin if not Assigned(FInstance) then begin Result := Unassigned; Exit; end; PropInfo := PropInfos[Index]; if GetTypeInfo(PropInfo)^.Kind = tkFloat then begin if GetTypeData(GetTypeInfo(PropInfo)).FloatType = ftCurr then begin CurrencyValue := GetFloatProp(FInstance, PropInfo); Result := CurrencyValue; end else begin Value := GetFloatProp(FInstance, PropInfo); if (GetTypeInfo(PropInfo) = TypeInfo(TDateTime)) // or (PropInfo.PropType^ = TypeInfo(TDate)) // or (PropInfo.PropType^ = TypeInfo(TTime)) then Result := VarFromDateTime(Value) else Result := Value; end end else Result := GetPropValue(FInstance, Names[Index]); end; end.
一、前言 关于开源框架这块,其实主要是针对自己项目中使用到的框架进行准备。从使用,到使用场景、优缺点以及源码实现都需要逐一掌握理解。这一部分是向面试官展示自己水平与能力的一个重要部分,所以要着重准备。 针对开源框架,该部分整理了自己在做项目过程中使用到的几个框架。大多都是从网上找的一些大佬的文章,深入浅出,着重讲述源码实现,可以帮助自己更好的理解。 二、目录 OkHttp解析 Retrofit解析
本文向大家介绍JavaScript跨平台的开源框架NativeScript,包括了JavaScript跨平台的开源框架NativeScript的使用技巧和注意事项,需要的朋友参考一下 NativeScript是一款使用JavaScript语言来构建跨平台原生移动应用的开源框架,支持iOS、Android和Windows Phone。且NativeScript的使用没有过多繁杂的要求,只需使用自己已
SAE上部署Dokuwiki的开源框架,显示无法登陆注册,同时Email功能无法使用。 2014-09-19 15:12 提问者采纳 去SAE应用仓库看看吧 sae不支持写入 Email也要修改代码,SAE邮件class , 目前只支持SMTP. <?php $mail =new SaeMail(); $mail->setAttach(array("my_photo.jpg" =>"照片的二进制数
InstantObjects是delphi上的一个不错的ORM框架,可以实现类似hibernate的功能。 具有如下优点 * 将数据表间关系转化成了对象和对象的关系,简单直观。 * 可以自动创建数据库,简化了部署的和安装的过程。 * 支持多种数据库,方便了程序的移植。 * 便于进行测试驱动的开发。
本文向大家介绍Python六大开源框架对比,包括了Python六大开源框架对比的使用技巧和注意事项,需要的朋友参考一下 Python 是一门动态、面向对象语言。其最初就是作为一门面向对象语言设计的,并且在后期又加入了一些更高级的特性。除了语言本身的设计目的之外,Python标准 库也是值得大家称赞的,Python甚至还自带服务器。其它方面,Python拥有足够多的免费数据函数库、免费的Web网页模
作者:hiyuki Mpx是一款致力于提高小程序开发体验的增强型小程序框架,通过Mpx,我们能够以最先进的web开发体验(Vue + Webpack)来开发生产性能深度优化的小程序,Mpx具有以下一些优秀特性: 数据响应特性(watch/computed) 增强的模板语法(动态组件/样式绑定/类名绑定/内联事件函数/双向绑定等) 深度性能优化(原生自定义组件/基于依赖收集和数据变化的setData
本文向大家介绍详解开源的JavaScript插件化框架MinimaJS,包括了详解开源的JavaScript插件化框架MinimaJS的使用技巧和注意事项,需要的朋友参考一下 本文介绍我开发的一个JavaScript编写的插件化框架——MinimaJS,完全开源,源码下载地址:https://github.com/lorry2018/minimajs。该框架参考OSGi规范,将该规范定义的三大插件
本文向大家介绍浅谈Zookeeper开源客户端框架Curator,包括了浅谈Zookeeper开源客户端框架Curator的使用技巧和注意事项,需要的朋友参考一下 zookeepercurator Curator是Netflix开源的一套ZooKeeper客户端框架. Netflix在使用ZooKeeper的过程中发现ZooKeeper自带的客户端太底层, 应用方在使用的时候需要自己处理很多事情,