Так полагаю, что вы ждете от меня готового решения. Но у меня сейчас нет ни времени ни желания писать за кого-то код.
Вопрос к автору, для чего создается этот XML и его формат обязательно должен быть таким как привели?
Если формат обязательно должен быть таким, тогда немного переделанный код
vada:
- Код: Выделить всё
program TestXML;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this };
type
TRecordLine = class
public
Idx: Integer;
Name: String;
Parent: Integer;
Key: String;
Img: String;
constructor Create(aIdx: Integer; aName: String; aParent: Integer; aKey: String; aImg: String);
end;
TRecordsList = array of TRecordLine;
var
L: TRecordsList;
F: Text;
constructor TRecordLine.Create(aIdx: Integer; aName: String; aParent: Integer; aKey: String; aImg: String);
begin
Idx := aIdx;
Name := aName;
Parent := aParent;
Key := aKey;
Img := aImg;
end;
{ Ну как тут вы будете стркутуру заполнять, придумаете сами }
procedure Init;
var
J: Integer;
begin
Assign(F, 'test.xml');
Rewrite(F);
SetLength(L, 9);
J := 0;
L[J] := TRecordLine.Create(1, 'Двери', 0, 'cneljwnclwncvwjv', 'pic01.jpg');
j += 1;
L[J] := TRecordLine.Create(2, 'Входные двери', 1, 'hfwfcwefbcwebf', '');
J += 1;
L[J] := TRecordLine.Create(3, 'Бренд 1', 2, 'qtweqwytqycd', '');
J += 1;
L[J] := TRecordLine.Create(4, 'Бренд 2', 2, 'reihurevifvb', '');
J += 1;
L[J] := TRecordLine.Create(5, 'Межкомнатные двери', 1, 'pjpjnkjnkn', '');
J += 1;
L[J] := TRecordLine.Create(6, 'Марка 1', 4, 'iohiuhui', '');
J += 1;
L[J] := TRecordLine.Create(7, 'Марка 2', 4, 'buguufuf', '');
J += 1;
L[J] := TRecordLine.Create(8, 'Марка 1', 3, 'dioooidjh', '');
J += 1;
L[J] := TRecordLine.Create(9, 'Бренд 3', 2, 'hgorehgrth', '');
end;
procedure WriteRecordToXML(pS: String; Parent: Integer);
var
I: Integer;
Rc: TRecordLine;
S: String;
begin
for I := 0 to Length(L) - 1 do begin
Rc := L[I];
if Rc.Parent <> Parent then Continue;
WriteLn(F,pS+'<group>');
S := pS+#9;
WriteLn(F,S+'<id>'+Rc.Key+'</id>');
WriteLn(F,S+'<sort>100</sort>');
WriteLn(F,S+'<name>'+Rc.Name+'</name>');
WriteLn(F,S+'<picture>'+Rc.Img+'</picture>');
if Rc.Idx <> Rc.Parent then WriteRecordToXML(S, Rc.Idx);
WriteLn(F,pS+'</group>');
end;
end;
procedure Run;
begin
//
WriteLn(F, '<?xml version="1.0" encoding="utf-8" ?>');
WriteRecordToXML('', 0);
end;
procedure Done;
var
I: Integer;
begin
for I := 0 to Length(L) - 1 do L[I].Free;
SetLength(L, 0);
Flush(F);
Close(F);
end;
begin
Init;
Run;
Done;
end.
Для
- Код: Выделить всё
N Name Parent_N id
1 Двери 0 cneljwnclwncvwjv
2 Входные двери 1 hfwfcwefbcwebf
3 Бренд 1 2 qtweqwytqycd
4 Бренд 2 2 reihurevifvb
5 Межкомнатные двери 1 pjpjnkjnkn
6 Марка 1 4 iohiuhui
7 Марка 2 4 buguufuf
8 Марка 1 3 dioooidjh
9 Бренд 3 2 hgorehgrth
вывод будет таким:
- Код: Выделить всё
<?xml version="1.0" encoding="utf-8" ?>
<group>
<id>cneljwnclwncvwjv</id>
<sort>100</sort>
<name>Двери</name>
<picture>pic01.jpg</picture>
<group>
<id>hfwfcwefbcwebf</id>
<sort>100</sort>
<name>Входные двери</name>
<picture></picture>
<group>
<id>qtweqwytqycd</id>
<sort>100</sort>
<name>Бренд 1</name>
<picture></picture>
<group>
<id>dioooidjh</id>
<sort>100</sort>
<name>Марка 1</name>
<picture></picture>
</group>
</group>
<group>
<id>reihurevifvb</id>
<sort>100</sort>
<name>Бренд 2</name>
<picture></picture>
<group>
<id>iohiuhui</id>
<sort>100</sort>
<name>Марка 1</name>
<picture></picture>
</group>
<group>
<id>buguufuf</id>
<sort>100</sort>
<name>Марка 2</name>
<picture></picture>
</group>
</group>
<group>
<id>hgorehgrth</id>
<sort>100</sort>
<name>Бренд 3</name>
<picture></picture>
</group>
</group>
<group>
<id>pjpjnkjnkn</id>
<sort>100</sort>
<name>Межкомнатные двери</name>
<picture></picture>
</group>
</group>
Добавлено спустя 12 минут 6 секунд:Ну а вот все тоже самое, только без классов:
- Код: Выделить всё
program TestXML;
{$mode objfpc}{$H+}
type
TRecordLine = record
Idx: Integer;
Name: String;
Parent: Integer;
Key: String;
Img: String;
end;
TRecordsList = array of TRecordLine;
var
L: TRecordsList;
F: Text;
procedure SetRecordLine(I: Integer; aIdx: Integer; aName: String; aParent: Integer; aKey: String; aImg: String);
begin
with L[I] do begin
Idx := aIdx;
Name := aName;
Parent := aParent;
Key := aKey;
Img := aImg;
end;
end;
{ Ну как тут вы будете стркутуру заполнять, придумаете сами }
procedure Init;
var
J: Integer;
begin
Assign(F, 'test.xml');
Rewrite(F);
SetLength(L, 9);
J := 0;
SetRecordLine(J, 1, 'Двери', 0, 'cneljwnclwncvwjv', 'pic01.jpg');
j += 1;
SetRecordLine(J, 2, 'Входные двери', 1, 'hfwfcwefbcwebf', '');
J += 1;
SetRecordLine(J, 3, 'Бренд 1', 2, 'qtweqwytqycd', '');
J += 1;
SetRecordLine(J, 4, 'Бренд 2', 2, 'reihurevifvb', '');
J += 1;
SetRecordLine(J, 5, 'Межкомнатные двери', 1, 'pjpjnkjnkn', '');
J += 1;
SetRecordLine(J, 6, 'Марка 1', 4, 'iohiuhui', '');
J += 1;
SetRecordLine(J, 7, 'Марка 2', 4, 'buguufuf', '');
J += 1;
SetRecordLine(J, 8, 'Марка 1', 3, 'dioooidjh', '');
J += 1;
SetRecordLine(J, 9, 'Бренд 3', 2, 'hgorehgrth', '');
end;
procedure WriteRecordToXML(pS: String; Parent: Integer);
var
I: Integer;
Rc: TRecordLine;
S: String;
begin
for I := 0 to Length(L) - 1 do begin
Rc := L[I];
if Rc.Parent <> Parent then Continue;
WriteLn(F,pS+'<group>');
S := pS+#9;
WriteLn(F,S+'<id>'+Rc.Key+'</id>');
WriteLn(F,S+'<sort>100</sort>');
WriteLn(F,S+'<name>'+Rc.Name+'</name>');
WriteLn(F,S+'<picture>'+Rc.Img+'</picture>');
if Rc.Idx <> Rc.Parent then WriteRecordToXML(S, Rc.Idx);
WriteLn(F,pS+'</group>');
end;
end;
procedure Run;
begin
//
WriteLn(F, '<?xml version="1.0" encoding="utf-8" ?>');
WriteRecordToXML('', 0);
end;
procedure Done;
begin
Flush(F);
Close(F);
end;
begin
Init;
Run;
Done;
end.
И в итоге скомпилированный екзешник меньше 100кб.
Добавлено спустя 8 минут:Но как я сказал, времени и желания делать чужую работу у меня особо нету, поэтому это тоже говнокод на скорую руку, для больших входных объемов данных переделывайте алгоритм, иначе будет неимоверно тормозить.
