Вот мое собственное решение.
Поскольку я очень люблю полиморфизм, я на самом деле также хочу решение, которое может быть встроено в иерархию объектов. Допустим, TTestObject и TTestObjectList - это наш BASE-объект. И с этого мы спускаемся к TMyObject, а также к TMyObjectList. Более того, я внес изменения как в Object, так и в List - добавил свойства для Marshaller / UnMarshaller
TMyObject = class(TTestObject) and TMyObjectList<T:TMyObject> = class(TTestObjectList)
С этим мы теперь вводим некоторые новые проблемы. То есть. как обрабатывать сортировку разных типов между строками в иерархии и как обрабатывать TJsonMarshal и TJsonUnMarshal как свойства в TTestObject и List.
Этого можно избежать, введя два новых метода на уровне TTestObject. Две функции класса, называемые RegisterConverters и RegisterReverters. Затем мы переходим и меняем маршальную функцию TTestObjectList на более простой маршаллинг.
Две функции и свойства класса для объекта и списка.
class procedure RegisterConverters(aClass: TClass; aMar: TJSONMarshal); virtual;
class procedure RegisterReverters(aClass: TClass; aUnMar: TJSONUnMarshal); virtual;
property Mar: TJSONMarshal read FMar write SetMar;
property UnMar: TJSONUnMarshal read FUnMar write SetUnMar;
Функция Маршала List теперь может быть выполнена следующим образом:
function TObjectList<T>.Marshal: TJSONObject;
begin
if FMar = nil then
FMar := TJSONMarshal.Create(); // thx. to SilverKnight
try
RegisterConverters; // Virtual class method !!!!
try
Result := FMar.Marshal(Self) as TJSONObject;
except
on e: Exception do
raise Exception.Create('Marshal Error : ' + e.Message);
end;
finally
ClearMarshal; // FreeAndNil FMar and FUnMar if assigned.
end;
end;
Конечно, у нас все еще может быть маршаллер для нашего TTestObject, но функция Маршала TTestObjectList НЕ будет его использовать. Таким образом, только ОДИН маршаллер будет создан при вызове маршала TTestObjectList (или потомков). И таким образом мы в конечном итоге получаем только ту информацию, которая нам необходима для воссоздания нашей структуры, когда мы делаем все наоборот - UnMarshalling: -)
Теперь это действительно работает, но мне интересно, есть ли у кого-нибудь комментарии по этому поводу?
Позволяет добавить свойство «TimeOfCreation» в TMyTestObject:
свойство TimeOfCreation: TDateTime читает FTimeOfCreation, записывает FTimeOfCreation;
И установить свойство в конструкторе.
FTimeofCreation := now;
И затем нам нужен конвертер, поэтому мы переопределяем виртуальные RegisterConverters TTestObject.
class procedure TMyTestObject.RegisterConverters(aClass: TClass; aMar: TJSONMarshal);
begin
inherited; // instanciate marshaller and register TTestObject converters
aMar.RegisterConverter(aClass, 'FTimeOfCreation',
function(Data: TObject; Field: String): string
var
ctx: TRttiContext;
date: TDateTime;
begin
date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>;
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', date);
end);
end;
Я получаю очень простой источник, например TTestObject, т.е.
aList := TMyTestObjectList<TMyTestObject>.Create;
aList.Add(TMyTestObject.Create(['one','two']));
aList.Add(TMyTestObject.Create(['three']));
s := (aList.Marshal).ToString;
Writeln(s);
И теперь мне удалось раскошелиться с полиморфизмом: -)
Это также работает с UnMarshalling, кстати. И я нахожусь в процессе перестройки моего FireBird ORM для создания исходного кода для всех моих объектов, подобных этому.
Текущую старую версию можно найти здесь:
http://code.google.com/p/objectgenerator/
Помните, что это работает только для FireBird: -)