Delphi 下的 ORMapping 简单实现源代码,贴出来和大家分享
包含三个单元, uRTTIFunctions, uORMapping, uORMappingInterface
使用时引用uORMappingInterface 单元即可
uses SysUtils, Classes, DB;
type
IORMappingController
['{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.
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
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 :
if PropInfo <> nil then
begin
if PropInfo^.PropType^.Kind = tkFloat then
Result := GetFloatProp(AComp, APropName);
end;
end;
end.
uses SysUtils, Classes, DB, TypInfo, uORMappingInterface;
type
TORMappingController
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
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:
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
SetFloatProp(AObject, PropName, ADataSet.FieldByName(PropName).AsFloat);
end;
tkString, tkLString:
begin
SetStrProp(AObject, PropName, ADataSet.FieldByName(PropName).AsString);
end;
end;
end;
finally
FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;
end;
end;
end.