Me contesto solo por si alguno le interesa, asi quedo mi procedimiento
GetPropList, no lee los elementos de clases, entonces tuve que hacerlo con cast o casteo, no se en realidad como se dice...
No sabia castear, pero cuando lei un poco por aca y otro poco en google, fue mas facil de lo que parecia
Código Delphi
[-]
procedure GetPropertyObject(Obj: TObject; List: TStringList; Counter: Integer);
var
Names, Value, cName, iName: String;
PInfo: PPropInfo;
PropList: PPropList;
Count, i, j: Integer;
Ob: TObject;
begin
Count := GetPropList(Obj.ClassInfo, tkProperties, nil);
GetMem(PropList, Count * SizeOf(PPropInfo));
GetPropList(Obj.ClassInfo, tkProperties, PropList);
cName := Obj.ClassName;
Delete(cName, 1, 1); List.Add('<'+ cName +'>');
for i := 0 to Count -1 do
begin
Value := GetPropValue(Obj, Proplist[i].Name);
PInfo := GetPropInfo(Obj, Proplist[i].Name);
Names := Proplist[i].Name;
if PInfo <> nil then
begin
if PInfo^.PropType^.Kind = tkClass then
begin
Ob := GetObjectProp(Obj, Proplist[i].Name);
if Ob is TCollection then
begin
List.Add('<'+ Names +'>');
for j := 0 to (Ob as TATS_List).Count - 1 do
begin
iName := (Ob as TATS_List).Items[j].Name;
Value := (Ob as TATS_List).Items[j].Value;
List.Add('<' + iName + '>'+ Value +''+ iName +'>');
end;
List.Add(''+ Names +'>');
end
else
begin
GetPropertyObject(Ob, List, Counter + 1);
end;
end
else
begin
List.Add('<'+ Names +'>'+ Value +''+ Names +'>');
end;
end;
end;
List.Add(''+ cName +'>');
end;
Por las dudas aqui mi unidad Colecciones
Código Delphi
[-]
unit ATS_Collections;
interface
uses
SysUtils, Classes, Variants;
type
TATS_Item = class(TCollectionItem)
private
FData: Variant;
FName: String;
FNull: Boolean;
FBound: Boolean;
FNativeStr: String;
function GetAsVariant: Variant;
procedure SetAsVariant(const Value: Variant);
function GetAsBoolean: Boolean;
function GetAsDateTime: TDateTime;
function GetAsFloat: Double;
function GetAsInteger: LongInt;
function GetAsString: String;
function GetIsNull: Boolean;
function IsEqual(Value: TATS_Item): Boolean;
procedure SetAsBoolean(const Value: Boolean);
procedure SetAsDate(const Value: TDateTime);
procedure SetAsDateTime(const Value: TDateTime);
procedure SetAsFloat(const Value: Double);
procedure SetAsInteger(const Value: LongInt);
procedure SetAsString(const Value: String);
procedure SetAsTime(const Value: TDateTime);
procedure SetAsWord(const Value: LongInt);
procedure SetText(const Value: String);
protected
function GetDisplayName: String; override;
public
constructor Create(Collection: TCollection); overload; override;
procedure Clear;
property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
property AsDate: TDateTime read GetAsDateTime write SetAsDate;
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
property AsFloat: Double read GetAsFloat write SetAsFloat;
property AsInteger: LongInt read GetAsInteger write SetAsInteger;
property AsString: String read GetAsString write SetAsString;
property AsTime: TDateTime read GetAsDateTime write SetAsTime;
property AsWord: LongInt read GetAsInteger write SetAsWord;
property Bound: Boolean read FBound write FBound;
property IsNull: Boolean read GetIsNull;
property NativeStr: String read FNativeStr write FNativeStr;
property Text: String read GetAsString write SetText;
published
property Name: String read FName write FName;
property Value: Variant read GetAsVariant write SetAsVariant;
end;
TATS_List = class(TCollection)
private
function GetItem(Index: Integer): TATS_Item;
procedure SetItem(Index: Integer; const Value: TATS_Item);
public
procedure AddPameter(AName: String; AValue: Variant);
procedure AssignValues(Value: TATS_List);
function IsEqual(Value: TATS_List): Boolean;
function ParamByName(const Value: String): TATS_Item;
function FindParam(const Value: String): TATS_Item;
property Items[Index: Integer]: TATS_Item read GetItem write SetItem; default;
end;
implementation
constructor TATS_Item.Create(Collection: TCollection);
begin
inherited;
FNull := True;
end;
procedure TATS_Item.Clear;
begin
FNull := True;
FData := Unassigned;
end;
function TATS_Item.GetAsBoolean: Boolean;
begin
if IsNull then
Result := False
else
Result := FData;
end;
function TATS_Item.GetAsDateTime: TDateTime;
begin
if IsNull then
Result := 0
else
Result := VarToDateTime(FData);
end;
function TATS_Item.GetAsFloat: Double;
begin
if IsNull then
Result := 0
else
Result := FData;
end;
function TATS_Item.GetAsInteger: LongInt;
begin
if IsNull then
Result := 0
else
Result := FData;
end;
function TATS_Item.GetAsString: String;
begin
if IsNull then
Result := ''
else
Result := FData;
end;
function TATS_Item.GetAsVariant: Variant;
begin
Result := FData;
end;
function TATS_Item.GetIsNull: Boolean;
begin
Result := FNull or VarIsNull(FData) or VarIsClear(FData);
end;
procedure TATS_Item.SetAsBoolean(const Value: Boolean);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsDate(const Value: TDateTime);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsDateTime(const Value: TDateTime);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsFloat(const Value: Double);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsInteger(const Value: LongInt);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsString(const Value: String);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsTime(const Value: TDateTime);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetAsVariant(const Value: Variant);
begin
FNull := VarIsClear(Value) or VarIsNull(Value);
FData := Value;
end;
procedure TATS_Item.SetAsWord(const Value: LongInt);
begin
Self.Value := Value;
end;
procedure TATS_Item.SetText(const Value: String);
begin
Self.Value := Value;
end;
function TATS_Item.GetDisplayName: String;
begin
if FName = '' then
Result := inherited GetDisplayName
else
Result := FName;
end;
function TATS_Item.IsEqual(Value: TATS_Item): Boolean;
begin
Result := (VarType(FData) = VarType(Value.FData)) and
(VarIsClear(FData) or (FData = Value.FData)) and
(Name = Value.Name) and (IsNull = Value.IsNull);
end;
procedure TATS_List.AddPameter(AName: String; AValue: Variant);
var
P: TATS_Item;
begin
P := TATS_Item(Self.Add);
P.Name := AName;
P.Value := AValue;
end;
procedure TATS_List.AssignValues(Value: TATS_List);
var
I: Integer;
P: TATS_Item;
begin
for I := 0 to Value.Count - 1 do
begin
P := FindParam(Value[i].Name);
if P <> nil then
P.Assign(Value[i]);
end;
end;
function TATS_List.FindParam(const Value: String): TATS_Item;
var
I: Integer;
begin
for I := 0 to Count - 1 do
begin
Result := TATS_Item(inherited Items[i]);
if AnsiCompareText(Result.Name, Value) = 0 then Exit;
end;
Result := nil;
end;
function TATS_List.GetItem(Index: Integer): TATS_Item;
begin
Result := TATS_Item(inherited Items[Index]);
end;
function TATS_List.IsEqual(Value: TATS_List): Boolean;
var
I: Integer;
begin
Result := Count = Value.Count;
if Result then
for I := 0 to Count - 1 do
begin
Result := Items[i].IsEqual(Value.Items[i]);
if not Result then Break;
end
end;
function TATS_List.ParamByName(const Value: String): TATS_Item;
begin
Result := FindParam(Value);
if Result = nil then
raise Exception.Create('El parámetro no fue localizado');
end;
procedure TATS_List.SetItem(Index: Integer; const Value: TATS_Item);
begin
inherited SetItem(Index, TCollectionItem(Value));
end;
end.