Delphi RTTI

uses TypInfo

type
  TXRTTI=class

  public
    //给定一个数据集合将值设置给对象 //得到一个对象的属性的数据类型
    class function GetObjAttTypeInfo(obj:TPersistent;const AAtt:String;var ATypeInfo:TTypeInfo):Boolean;
    //给定一个属性名和值，给对象设置
    class function SetObjValue(obj:TPersistent;const AAtt:String;AValue:Variant;ATypeInfo:TTypeInfo):Boolean;overload;
    class function SetObjValue(obj:TPersistent;const AAtt:String;AValue:Variant):Boolean;overload;
    class function SetObjValueStr(obj:TPersistent;const AAtt:String;AValue:String):Boolean;overload;
    //根据一个属性名，得到对象的值
    class function GetObjValue(obj:TPersistent;const AAtt:String):Variant;
    class function GetObjValueToStr(obj:TPersistent;const AAtt:String):String;

  end;

  TXDB=class
    //将数据集转换为对象列表
    class function DataSetToList(ADOQ:TADOQuery;AClass:TPersistentClass;AList:TList):Integer;
    class function DataSetToObj(ADOQ:TADOQuery;obj:TPersistent;ARow:Integer=1):Boolean;
  end;

implementation

{ TXDB }

class function TXDB.DataSetToList(ADOQ:TADOQuery;AClass: TPersistentClass; AList: TList): Integer;
var
  obj:TPersistent;
  i,f:Integer;

  PropList: PPropList;
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
begin
//先取对象属性信息
  ClassTypeInfo := AClass.ClassInfo;
  ClassTypeData := GetTypeData(ClassTypeInfo);
  GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
  GetPropInfos(AClass.ClassInfo, PropList);

  for f:=0 to ADOQ.FieldCount-1 do
  begin
    ADOQ.Fields[f].Tag:=-1;
    for i := 0 to ClassTypeData.PropCount - 1 do
      if (PropList[i]^.PropType^.Kind <> tkMethod) then
        if SameText(ADOQ.Fields[f].FieldName,PropList[i]^.Name) then
        begin
          ADOQ.Fields[f].Tag:=i;
          Break;
        end;
  end;
//数据集合转换成对象列表
  while Not ADOQ.Eof do
  begin
    obj:=AClass.Create;
    for i:=0 to ADOQ.FieldList.Count-1 do
    begin
      if (ADOQ.Fields[i].Tag>=0)and(ADOQ.Fields[i].Value<>Null) then
        TXRTTI.SetObjValue(obj,ADOQ.Fields[i].FieldName,ADOQ.Fields[i].Value,PropList[ADOQ.Fields[i].Tag]^.PropType^^);
    end;
    AList.Add(obj);
    ADOQ.Next;
  end;

  FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
  Result:=AList.Count;
end;

class function TXDB.DataSetToObj(ADOQ: TADOQuery;
  obj:TPersistent;ARow:Integer=1): Boolean;
var
  i,f:Integer;

  PropList: PPropList;
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
begin
//先取对象属性信息
  ClassTypeInfo := obj.ClassInfo;
  ClassTypeData := GetTypeData(ClassTypeInfo);
  GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
  GetPropInfos(obj.ClassInfo, PropList);

  for f:=0 to ADOQ.FieldCount-1 do
  begin
    ADOQ.Fields[f].Tag:=-1;
    for i := 0 to ClassTypeData.PropCount - 1 do
      if (PropList[i]^.PropType^.Kind <> tkMethod) then
        if SameText(ADOQ.Fields[f].FieldName,PropList[i]^.Name) then
        begin
          ADOQ.Fields[f].Tag:=i;
          Break;
        end;
  end;
//数据集合转换成对象列表
  ADOQ.RecNo:=ARow;
  for i:=0 to ADOQ.FieldList.Count-1 do
  begin
    if (ADOQ.Fields[i].Tag>=0)and(ADOQ.Fields[i].Value<>Null) then
      TXRTTI.SetObjValue(obj,ADOQ.Fields[i].FieldName,ADOQ.Fields[i].Value,PropList[ADOQ.Fields[i].Tag]^.PropType^^);
  end;

  FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
  Result:=True;
end;

{ TXRTTI }

class function TXRTTI.GetObjAttTypeInfo(obj: TPersistent;
  const AAtt: String;var ATypeInfo:TTypeInfo): Boolean;
var
  i:Integer;

  PropList: PPropList;
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
begin
  Result:=False;
  ClassTypeInfo := obj.ClassType.ClassInfo;
  ClassTypeData := GetTypeData(ClassTypeInfo);
  GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
  GetPropInfos(obj.ClassInfo, PropList);

  for i := 0 to ClassTypeData.PropCount - 1 do
    if (PropList[i]^.PropType^.Kind <> tkMethod) then
      if SameText(AAtt,PropList[i]^.Name) then
      begin
       // AAtt:=PropList[i]^.Name; 属性名不区分大小写，所以不用反正正确的属性值
        ATypeInfo:=PropList[i]^.PropType^^;
        Result:=True;
        Break;
      end;
  FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;

class function TXRTTI.GetObjValue(obj: TPersistent;
  const AAtt: String): Variant;
var
  AKind:TTypeKind;
  ATypeInfo:TTypeInfo;
begin
//给定一个属性名称和值，给对应设置
  Result:=True;
  GetObjAttTypeInfo(obj,AAtt,ATypeInfo);

  case ATypeInfo.Kind of
    tkInteger :Result:=GetInt64Prop(obj,AAtt);
    tkFloat   :Result:=GetFloatProp(obj,AAtt);
    tkInt64   :Result:=GetInt64Prop(obj,AAtt);
    tkString  :Result:=GetStrProp(obj,AAtt);
    tkLString :Result:=GetStrProp(obj,AAtt);
    tkWString :Result:=GetStrProp(obj,AAtt);
    tkVariant :Result:=GetVariantProp(obj,AAtt);
    else
      Result:=null;
  end;
end;

class function TXRTTI.GetObjValueToStr(obj: TPersistent;
  const AAtt: String): String;
var
  AKind:TTypeKind;
  ATypeInfo:TTypeInfo;
begin
//给定一个属性名称和值，给对应设置
  GetObjAttTypeInfo(obj,AAtt,ATypeInfo);
  case ATypeInfo.Kind of
    tkInteger :Result:=IntToStr(GetInt64Prop(obj,AAtt));
    tkFloat   :Result:=FloatToStr(GetFloatProp(obj,AAtt));
    tkInt64   :Result:=IntToStr(GetInt64Prop(obj,AAtt));
    tkString  :Result:=GetStrProp(obj,AAtt);
    tkLString :Result:=GetStrProp(obj,AAtt);
    tkWString :Result:=GetStrProp(obj,AAtt);
    tkVariant :Result:=VarToStrDef(GetVariantProp(obj,AAtt),'');
    else
      Result:='';
  end;
end;

class function TXRTTI.SetObjValue(obj: TPersistent; const AAtt: String;
  AValue: Variant):Boolean;
var
  ATypeInfo:TTypeInfo;
begin
//给定一个属性名称和值，给对应设置
  GetObjAttTypeInfo(obj,AAtt,ATypeInfo);
  Result:=SetObjValue(obj,AAtt,AValue,ATypeInfo);
end;

class function TXRTTI.SetObjValue(obj: TPersistent; const AAtt: String;
  AValue: Variant; ATypeInfo: TTypeInfo): Boolean;
var
  i:Integer;
  f:Double;
  t:Int64;
begin
//给定一个属性名称和值，给对应设置
  Result:=True;
  case ATypeInfo.Kind of
    tkInteger:
      begin
        i:=AValue;
        SetInt64Prop(obj,AAtt,i);
      end;
    tkFloat  :
      begin
        f:=AValue;
        SetFloatProp(obj,AAtt,f);
      end;
    tkInt64:
      begin
        t:=AValue;
        SetInt64Prop(obj,AAtt,t);
      end;
    tkString:SetStrProp(obj,AAtt,AValue);
    tkLString:SetStrProp(obj,AAtt,AValue);
    tkWString:SetStrProp(obj,AAtt,AValue);
    tkVariant:SetVariantProp(obj,AAtt,AValue);
    else
      Result:=False;
  end;

end;

class function TXRTTI.SetObjValueStr(obj: TPersistent; const AAtt: String;
  AValue: String): Boolean;
var
  AKind:TTypeKind;
  i:Integer;
  f:Double;
  t:Int64;
  ATypeInfo:TTypeInfo;
begin
//给定一个属性名称和值，给对应设置
  Result:=True;
  GetObjAttTypeInfo(obj,AAtt,ATypeInfo);

  case ATypeInfo.Kind of
    tkInteger:
      begin
        i:=StrToIntDef(AValue,0);
        SetInt64Prop(obj,AAtt,i);
      end;
    tkFloat  :
      begin
        f:=StrToFloatDef(AValue,0);
        SetFloatProp(obj,AAtt,f);
      end;
    tkInt64:
      begin
        t:=StrToInt64Def(AValue,0);
        SetInt64Prop(obj,AAtt,t);
      end;
    tkString:SetStrProp(obj,AAtt,AValue);
    tkLString:SetStrProp(obj,AAtt,AValue);
    tkWString:SetStrProp(obj,AAtt,AValue);
    tkVariant:SetVariantProp(obj,AAtt,AValue);
    else
      Result:=False;
  end;

end;