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.

 

 

版权声明:本文为博主原创文章,未经博主允许不得转载。 举报

相关文章推荐

BeetlSQL 实现 ORMapping

我在 hibernate,mybatis,beetlsql 全面比较  中说明了BeetlSQL 在开发效率,维护性,跨数据库等各指标全面比hibernate 占有,但在ORM 方面不如Hiberna...

用delphi的Rtti实现数据集的简单对象化

用delphi的rtti实现数据集的简单对象化

我是如何成为一名python大咖的?

人生苦短,都说必须python,那么我分享下我是如何从小白成为Python资深开发者的吧。2014年我大学刚毕业..

delphi 实现简单工厂模式

计算器的功能实现 实现工厂设计模式 通过面向对象的思想,进行设计,所用的编程思想为对象的三大特性:封装,继承,多态 通过实现一个简单的 计算器的功能(输入两个数,进行加,减,乘,除) 思想思路: 1...

《大话设计模式》之 简单工厂模式 Delphi/C shap /JAVA 实现

{ 计算器的功能实现  实现工厂设计模式  通过面向对象的思想,进行设计,所用的编程思想为对象的三大特性:封装,继承,多态  通过实现一个简单的 计算器的功能(输入两个数,进行加,减,乘,除)...

用DELPHI的RTTI实现数据集的简单对象化

用DELPHI的RTTI实现数据集的简单对象化 CND8学院 Delphi教程 发布日期:2008年07月09日 将本文收藏到: | 收藏到本地 | 复制本文地址  在《强大...

用DELPHI的RTTI实现数据集的简单对象化(zt)

DELPHI的RTTI实现数据集的简单对象化 [Mental Studio]猛禽 在《强大的DELPHI RTTI--兼谈需要了解多种开发语言》一文中,我说了一下我用DELPHI的RTTI实现...
返回顶部
收藏助手
不良信息举报
您举报文章:深度学习:神经网络中的前向传播和反向传播算法推导
举报原因:
原因补充:

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