Delphi下ORMapping的简单实现

原创 2007年09月12日 20:17:00

Delphi 下的 ORMapping 简单实现源代码,贴出来和大家分享

包含三个单元, uRTTIFunctions, uORMapping, uORMappingInterface

使用时引用uORMappingInterface 单元即可

 

unit uORMappingInterface;

interface
uses SysUtils, Classes, DB;

type
  IORMappingController 
= interface
  [
'{47E74DEE-4F54-4FAD-888D-BA669F93732D}']
    procedure SetObjectPropertiesFromDataSet(AObject: TPersistent; ADataSet: TDataSet);
    procedure SetDataSetValuesFromObject(ADataSet: TDataSet; AObject: TPersistent);
  end;

  TORMappingControllerFactory 
= class(TObject)
  
public
    
class function GetInstance(Tag: Integer = 0): IORMappingController;
  end;

implementation
uses uORMapping;

{ TORMappingControllerFactory }

class function TORMappingControllerFactory.GetInstance(
  Tag: Integer): IORMappingController;
begin
  
if Tag = 0 then
    Result :
= TORMappingController.Create;
end;

end.

 

unit uRTTIFunctions;

interface
uses SysUtils, TypInfo;




procedure SetIntegerPropertyIfExists(AComp: TObject; APropName: String;
  AValue: Integer);
procedure SetObjectPropertyIfExists(AComp: TObject; APropName: String;
  AValue: TObject);
procedure SetBooleanPropertyIfExists(AComp: TObject; APropName: String;
  AValue: Boolean);
procedure SetStringPropertyIfExists(AComp: TObject; APropName: String;
  AValue: String);
procedure SetMethodPropertyIfExists(AComp: TObject; APropName: String;
  AMethod: TMethod);
procedure SetFloatPropertyIfExists(AComp: TObject; APropName: String;
  AValue: Extended);

function GetIntegerPropertyIfExists(AComp: TObject; APropName: String): Integer;

function GetObjectPropertyIfExists(AComp: TObject; APropName: String): TObject;

function GetBooleanPropertyIfExists(AComp: TObject; APropName: String): Boolean;

function GetStringPropertyIfExists(AComp: TObject; APropName: String): 
string;

function GetMethodPropertyIfExists(AComp: TObject; APropName: String): TMethod;

function GetFloatPropertyIfExists(AComp: TObject; APropName: String): Extended;

implementation

procedure SetIntegerPropertyIfExists(AComp: TObject; APropName: String;
  AValue: Integer);
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkInteger then
      SetOrdProp(AComp, PropInfo, AValue);
  end;
end;

procedure SetObjectPropertyIfExists(AComp: TObject; APropName: String;
  AValue: TObject);
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkClass then
      SetObjectProp(AComp, PropInfo, AValue);
  end;
end;

procedure SetBooleanPropertyIfExists(AComp: TObject; APropName: String;
  AValue: Boolean);
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkEnumeration then
      SetOrdProp(AComp, PropInfo, Integer(AValue));
  end;
end;

procedure SetStringPropertyIfExists(AComp: TObject; APropName: String;
  AValue: String);
var
  PropInfo: PPropInfo;
  TK: TTypeKind;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    TK :
= PropInfo^.PropType^.Kind;
    
if (TK = tkString) or (TK = tkLString) or (TK = tkWString) then
      SetStrProp(AComp, PropInfo, AValue);
  end;
end;

procedure SetMethodPropertyIfExists(AComp: TObject; APropName: String;
  AMethod: TMethod);
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkMethod then
      SetMethodProp(AComp, PropInfo, AMethod);
  end;
end;

procedure SetFloatPropertyIfExists(AComp: TObject; APropName: String;
  AValue: Extended);
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkFloat then
      SetFloatProp(AComp, PropInfo, AValue);
  end;
end;

function GetIntegerPropertyIfExists(AComp: TObject; APropName: String): Integer;
var
  PropInfo: PPropInfo;
begin
  Result :
= 0;
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkInteger then
      Result :
= GetOrdProp(AComp, APropName);
  end;
end;

function GetObjectPropertyIfExists(AComp: TObject; APropName: String): TObject;
var
  PropInfo: PPropInfo;
begin
  Result :
= nil;
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkClass then
      Result :
= GetObjectProp(AComp, APropName);
  end;
end;

function GetBooleanPropertyIfExists(AComp: TObject; APropName: String): Boolean;
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkEnumeration then
      Result :
= Boolean(GetOrdProp(AComp, APropName));
  end;
end;

function GetStringPropertyIfExists(AComp: TObject; APropName: String): 
string;
var
  PropInfo: PPropInfo;
  TK: TTypeKind;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    TK :
= PropInfo^.PropType^.Kind;
    
if (TK = tkString) or (TK = tkLString) or (TK = tkWString) then
      Result :
= GetStrProp(AComp, APropName);
  end;
end;

function GetMethodPropertyIfExists(AComp: TObject; APropName: String): TMethod;
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkMethod then
      GetMethodProp(AComp, APropName);
  end;
end;

function GetFloatPropertyIfExists(AComp: TObject; APropName: String): Extended;
var
  PropInfo: PPropInfo;
begin
  PropInfo :
= GetPropInfo(AComp.ClassInfo, APropName);
  
if PropInfo <> nil then
  begin
    
if PropInfo^.PropType^.Kind = tkFloat then
      Result :
= GetFloatProp(AComp, APropName);
  end;
end;

end.

 

unit uORMapping;

interface
uses SysUtils, Classes, DB, TypInfo, uORMappingInterface;

type
  TORMappingController 
= class(TInterfacedObject, IORMappingController)
  
protected
    procedure SetObjectPropertiesFromDataSet(AObject: TPersistent; ADataSet: TDataSet);
    procedure SetDataSetValuesFromObject(ADataSet: TDataSet; AObject: TPersistent);
  end;

implementation
uses uRTTIFunctions;

{ TORMappingController }

procedure TORMappingController.SetDataSetValuesFromObject(
  ADataSet: TDataSet; AObject: TPersistent);
var
  i: integer;
begin
  
for i := 0 to ADataSet.FieldCount - 1 do
  begin
    
case ADataSet.Fields[i].DataType of
      ftString:
        ADataSet.Fields[i].AsString :
= GetStringPropertyIfExists(AObject, ADataSet.Fields[i].FieldName);
      ftSmallint, ftInteger, ftWord:
        ADataSet.Fields[i].AsInteger :
= GetIntegerPropertyIfExists(AObject, ADataSet.Fields[i].FieldName);
      ftFloat, ftCurrency, ftBCD:
        ADataSet.Fields[i].AsFloat :
= GetFloatPropertyIfExists(AObject, ADataSet.Fields[i].FieldName);
    end;
  end;
end;

procedure TORMappingController.SetObjectPropertiesFromDataSet(
  AObject: TPersistent; ADataSet: TDataSet);
var
  FPropNames: TStringList;
  PropList: PPropList;
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
  i: integer;
  PropName, PropTypeName: 
string;
begin

  ClassTypeInfo :
= AObject.ClassInfo;
  ClassTypeData :
= GetTypeData(ClassTypeInfo);

  
if ClassTypeData.PropCount <> 0 then
  begin
    
// allocate the memory needed to hold the references to the TPropInfo
    
// structures on the number of properties.
    GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
    
try
      
// fill PropList with the pointer references to the TPropInfo structures
      GetPropInfos(AObject.ClassInfo, PropList);
      
for i := 0 to ClassTypeData.PropCount - 1 do
      begin
        PropName :
= PropList[i]^.Name;
        PropTypeName :
= PropList[i]^.PropType^.Name;

        
case PropList[i]^.PropType^.Kind of
          tkInteger:
          begin
            
if ADataSet.FindField(PropName) <> nil then
              SetOrdProp(AObject, PropName, ADataSet.FieldByName(PropName).AsInteger);
          end;

          tkFloat:
          begin
            
if ADataSet.FindField(PropName) <> nil then
              SetFloatProp(AObject, PropName, ADataSet.FieldByName(PropName).AsFloat);
          end;

          tkString, tkLString:
          begin
            
if ADataSet.FindField(PropName) <> nil then
              SetStrProp(AObject, PropName, ADataSet.FieldByName(PropName).AsString);
          end;
        end;
      end;
    
finally
      FreeMem(PropList, SizeOf(PPropInfo) 
* ClassTypeData.PropCount);
    end;
  end;

end;

end.

 

 

基于配置的ORMapping框架浅析之1

基于配置的ORMapping框架浅析之1(以自己开发的框架为例子) 收藏     框架编程目前已经是一种构建伸缩性和高可用性的一种很普遍采用的方式,框架编程的优点有很多,它把思想和技术有机的集合...
  • qq_26975307
  • qq_26975307
  • 2016年12月22日 15:25
  • 529

利用图版背景颜色将PANEL透明化

//-------------------- panel 透明 //* HRGN hRgn = NULL; Graphics::TBitmap* MemoryBitmap ...
  • cmlxiaogeaaa
  • cmlxiaogeaaa
  • 2015年10月08日 14:14
  • 387

ormapping框架和jdbc的比较

ormapping框架的优点和缺点: 优点 1,比较简单,简化了DAO层的编码工作 2,数据缓存:一级缓存 二级缓存 查询缓存 3,移植性比较好 缺点 1,因为sql语句...
  • A__17
  • A__17
  • 2015年09月23日 15:42
  • 527

自定义ORMapping—关系表转换为实体或实体集合对象

概述        ORMapping,中文翻译过来就是,关系对象的映射,他的作用就是使我们编程时,不用过多的关注持久层,只需要关注对象,关注业务就可以了。 ORMapping主要完成两个功能:自动生...
  • jiben2qingshan
  • jiben2qingshan
  • 2014年06月30日 22:46
  • 2147

Hibernate(ORMapping) 上手实例与配置过程

利用一晚上的时间配置了一下Hibernate,做了一个简单的demo练习实现对数据库的增删改查,接下来我一步步的分析并且会指出每一步大家该注意的地方。 首先引进jar包:接下来,我们来看一下目录:好...
  • hqm12345qw
  • hqm12345qw
  • 2016年09月13日 01:16
  • 779

关于ormapping

ormapping的意思是object-relation mapping 对象关系映射。即表明ormapping是让对象跟数据库建立关系的框架。那么它是怎样建立关系的呢? 通过配置文件,拿我们老生常...
  • andy_px
  • andy_px
  • 2015年09月01日 21:02
  • 965

ORMapping 框架使用最佳实践

1.使用分析设计工具,任何时候都要使自己的分析设计模型与代码模型保持一致。2.领域驱动3.利用分析设计工具自动生成部分代码,尽量自动生成配置和有关属性。4.在基类中就封装好:Save、Delete、L...
  • greenyork
  • greenyork
  • 2009年07月14日 15:46
  • 294

OR Mapping的数据模式

程序语言已经由面向过程的模型全面转向为面向对象的模型,UML的出现更加革新了软件开发方法论。O/R Mapping的概念也就应运而生了。 为什么要提出O/R Mapping概念  程序语言已经由面向...
  • yaba213
  • yaba213
  • 2009年09月16日 08:53
  • 1861

自定义ORMapping—动态生成SQL语句

概述        之前在自定义ORMapping——关系表转换为实体或实体集合对象中提到过ORMapping的东西,在那片博客中也有ORMapping实现的一个简单思路,当时只实现了关系表转换为实...
  • jiben2qingshan
  • jiben2qingshan
  • 2014年11月30日 19:02
  • 1803

Hibernate——ORMapping(二)

第八种:多对多单向关联 一、Annotation配置 每个Teacher可以有多个Student,每个Student可以被多个Teacher教   1.Teacher.java packag...
  • yaguanzhou2014
  • yaguanzhou2014
  • 2015年01月06日 23:29
  • 398
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Delphi下ORMapping的简单实现
举报原因:
原因补充:

(最多只允许输入30个字)