Jcl Сортировка Xml

[markl]

Уважаемые форумчане, прошу Вашей помощи!

Используя XE2 (x86) и TJclSimpleXML из библиотеки JCL ($Date:: 2012-09-04, $Rev:: 3861) пытаюсь отсортировать теги по значению их свойства (если оно есть) и получаю Invalid pointer operation.

procedure T_MainForm._Sort(Elems: TJclSimpleXMLElems);
var i : Integer;
begin
Elems.CustomSort(CompareXMLItems);
for i := 0 to Elems.Count-1 do
if Elems[i].Items<>nil then
if Elems[i].ItemCount>1 then
_Sort(Elems[i].Items);
end;

function T_MainForm.CompareXMLItems(Elems: TJclSimpleXMLElems; Index1, Index2: Integer): Integer;
begin
if (Elems[Index1].Properties<>nil) and (Elems[Index2].Properties<>nil) then
begin
if Elems[Index1].Properties.IntValue('Id')<Elems[Index2].Properties.IntValue('Id') then Result := -1 else
if Elems[Index1].Properties.IntValue('Id')>Elems[Index2].Properties.IntValue('Id') then Result := 1 else
Result := 0;
end else Result := 0;
end;

procedure T_MainForm.Button1Click(Sender: TObject);
var fName : String;
begin
fName := ExtractFilePath(ParamStr(0))+'entity.xml';
xml := TJclSimpleXML.Create;
xml.LoadFromFile(fName);
_Sort(xml.Root.Items);
xml.Options := xml.Options - [sxoAutoEncodeValue];
xml.SaveToFile(fName+'.!!!.xml');
FreeAndNil(xml);
end;

Ошибка возникает в фукнкции JclSimpleXml.QuickSort в момент переприсваивания указателей.

Помогите, пж, понять: в чём я не прав?

Полный проект в приложении.

 

[sinkopa]

Уважаемые форумчане, прошу Вашей помощи!
Используя XE2 (x86) и TJclSimpleXML из библиотеки JCL ($Date:: 2012-09-04, $Rev:: 3861) пытаюсь отсортировать теги по значению их свойства (если оно есть) и получаю Invalid pointer operation.

Оооо да... Есть такой глюк у TJclSimpleXML... :lol:
При портировании под XE2 ребята забыли что свойсто OwnsObjects у TObjectList теперь по умолчанию True

Фиксится просто:
1. В Вашем Unit1.pas (после секции uses) добавляем строчки

type
TJclSimpleXMLElemsFix = class(JclSimpleXml.TJclSimpleXMLElems)
public
property ElemsFix: TJclSimpleItemHashedList read FElems;
end;

2. В метод T_MainForm._Sort добавляем строку (первой строкой)

procedure T_MainForm._Sort(Elems: TJclSimpleXMLElems);
var i : Integer;
begin
TJclSimpleXMLElemsFix(Elems).ElemsFix.OwnsObjects := False; {<====== добавленая строчка }
Elems.CustomSort(CompareXMLItems);
for i := 0 to Elems.Count-1 do
if Elems[i].Items<>nil then
if Elems[i].ItemCount>1 then
_Sort(Elems[i].Items);
end;

3. Сохраняем проект, компилируем, радуемся...
PS. При желании (на выходе метода) можно вернуть назад: TJclSimpleXMLElemsFix(Elems).ElemsFix.OwnsObjects := True

 

[markl]

Оооо да... Есть такой глюк у TJclSimpleXML... :lol:

Спасибо! Мне вот так ещё посоветовали отрихтовать исходник:

procedure QuickSort(Elems: TJclSimpleXMLElems; List: TList; L, R: Integer;
AFunction: TJclSimpleXMLElemCompare);
var
I, J, M: Integer;
T: Pointer;
begin
repeat
I := L;
J := R;
M := (L + R) shr 1;
repeat
while AFunction(Elems, I, M) < 0 do
Inc(I);
while AFunction(Elems, J, M) > 0 do
Dec(J);
if I <= J then
begin
if i<>j then begin  (*********)
T := List[I];
List[I] := List[J];
List[J] := T;
end;				 (*********)
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
QuickSort(Elems, List, L, J, AFunction);
L := I;
until I >= R;
end;

procedure TJclSimpleXMLElems.CustomSort(AFunction: TJclSimpleXMLElemCompare);
var OldOwn: boolean;
begin
if FElems <> nil then begin
OldOwn := FElems.OwnsObjects;
try
FElems.OwnsObjects := false;
QuickSort(Self, FElems, 0, FElems.Count - 1, AFunction);
finally
FElems.OwnsObjects := OldOwn;
end;
end;
end;

 

[sinkopa]

Спасибо! Мне вот так ещё посоветовали отрихтовать исходник:

Хм... не очень хорошо это, на мой взгляд, рихтовать чужой код...
Даже с чисто практической точки зрения...
Что например будет, если завтра Вы решите обновить (или переустановить) JVCL?
Или же вдруг Вам потребуется передать кому нибудь код Вашего проекта... :lol: