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.