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

Тема в разделе "Delphi - Компоненты", создана пользователем markl, 24 сен 2012.

  1. markl

    markl New Member

    Регистрация:
    24 сен 2012
    Сообщения:
    2
    Симпатии:
    0
    Уважаемые форумчане, прошу Вашей помощи!

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

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

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

    Вложения:

    • JCL_XML.RAR
      Размер файла:
      87 КБ
      Просмотров:
      4
  2. sinkopa

    sinkopa Well-Known Member

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

    Фиксится просто:
    1. В Вашем Unit1.pas (после секции uses) добавляем строчки
    Код (Delphi):
    type
    TJclSimpleXMLElemsFix = class(JclSimpleXml.TJclSimpleXMLElems)
    public
    property ElemsFix: TJclSimpleItemHashedList read FElems;
    end;
    2. В метод T_MainForm._Sort добавляем строку (первой строкой)
    Код (Delphi):
    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
     
  3. markl

    markl New Member

    Регистрация:
    24 сен 2012
    Сообщения:
    2
    Симпатии:
    0
    Спасибо! Мне вот так ещё посоветовали отрихтовать исходник:
    Код (Delphi):
    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;
     
  4. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    Хм... не очень хорошо это, на мой взгляд, рихтовать чужой код...
    Даже с чисто практической точки зрения...
    Что например будет, если завтра Вы решите обновить (или переустановить) JVCL?
    Или же вдруг Вам потребуется передать кому нибудь код Вашего проекта... :lol:
     
Загрузка...
Похожие Темы - Jcl Сортировка Xml
  1. vera2014
    Ответов:
    0
    Просмотров:
    1.071
  2. Liori
    Ответов:
    2
    Просмотров:
    1.005
  3. FCDK
    Ответов:
    0
    Просмотров:
    1.264
  4. ленарано
    Ответов:
    1
    Просмотров:
    1.103
  5. Creder
    Ответов:
    0
    Просмотров:
    1.345

Поделиться этой страницей