Delphi下ORMapping的简单实现

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.