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.
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.
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.
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.