Форум: "Основная";
Текущий архив: 2006.11.26;
Скачать: [xml.tar.bz2];

Вниз

XML as Registry   Найти похожие ветки 

← →
id   (2006-10-16 09:59) [0]

Необходимо работать с XML,  как с реестром.
Например функция код Pascal/Delphi
WriteString("Main\Moto\Test", "hello moto");
Должна записать в файл XML следующий код:Разметка XML

<Main>
<Moto>
 <Test>
  hello moto
 </Test>
</Moto>
</Main>

Причём если какие-либо записи уже существуют, то просто добавить.
И такой же вопрос с чтением. Помогите, пожалуйста, бьюсь с этим уже очень давно.

Начал я писать, но столкнулся с одной проблемой.
Код такой:
procedure Write(Path, Key, Value: string);
var
 N, P, K, root: IXMLNode;
 ts: TStringList;
 i: integer;
begin
 ts := TStringList.Create;
 ts.Delimiter := "/";
 ts.DelimitedText := Path;
 root := XML.DocumentElement;
 if root.ChildNodes.IndexOf(ts[0]) < 0 then
   N := root.AddChild(ts[0]) else
   N := root.ChildNodes.FindNode(ts[0]);
 for I := 1 to ts.Count - 1 do begin
   if N.ChildNodes.IndexOf(ts[i]) < 0 then
     P := N.AddChild(ts[i]) else P := N.ChildNodes.FindNode(ts[i]);
 end;
 K := P.AddChild(Key);
 K.Text := Value;
 ts.Free;
end;

Вызываю, например, так:
Write("Main/Hello/Moto/Love", "Test2", "45645646");
Всё записывается, но есть один недостаток. Пишет так:

<Main>
<Hello/>
 <Moto/>
   <Love>
     <Test2>45645646</Test2>
   </Love>
 </Main>

А я хочу, чтоб писало вот так:

<Main>
 <Hello>
   <Moto>
     <Love>
       <Test2>45645646</Test2>
     </Love>
   </Hello>
 </Moto/>
</Main>

Т.е нет закрывающего тега для тегов без параметров. И теги без параметров не выстраиваются "лесенкой".
Подскажите, пожалуйста, как быть?

---

← →
_RusLAN ©   (2006-10-16 10:26) [1]

у вас просто тег Love не входит в тег Moto, а тег Moto, в свою очередь, не входит в тег Hello.
Вы их добавляете просто в корень документа (и зря вы в примере сделали им отступ), так как N ссылается на корень.
Попробуйте так

N := N.AddChild(ts[i]) else N := N.ChildNodes.FindNode(ts[i]);

---

← →
_RusLAN ©   (2006-10-16 10:29) [2]

> [1] _RusLAN ©   (16.10.06 10:26)

и в строке
K := P.AddChild(Key);
тоже P замените на N

---

← →
id   (2006-10-16 10:32) [3]

Спасибо огромное. Казалось бы такая мелочь, но как я с ней замучался.

---

← →
Slym ©   (2006-10-16 10:34) [4]

procedure Write(const Path, Key, Value: string);
var
 ts: TStringList;
 Node:IXMLNode;
 i:integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node:=XML.DocumentElement;
   for i:=0 to ts.Count-1 do
   begin
     if Node.ChildNodes.IndexOf(ts[i])<0 then
       Node:=Node.AddChild(ts[i])
     else
      Node:=Node.ChildNodes.FindNode(ts[i]);
   end;
 finally
   ts.Free;
 end;
 Node:=Node.AddChild(Key);
 Node.Text:=Value;
end;

procedure WriteEx(const Path, Key:string;const Value: variant);
var
 ts: TStringList;
 Node:IXMLNode;
 i:integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node:=XML.DocumentElement;
   for i:=0 to ts.Count-1 do
   begin
     if Node.ChildNodes.IndexOf(ts[i])<0 then
       Node:=Node.AddChild(ts[i])
     else
      Node:=Node.ChildNodes.FindNode(ts[i]);
   end;
 finally
   ts.Free;
 end;
 Node:=Node.AddChild(Key);
 Node.Attributes["VarType"]:=VarType(Value);
 Node.Text:=VarToStr(Value);
end;

---

← →
id   (2006-10-16 10:36) [5]

Извините, но Вы бы не могли мне помочь с чтением?
Пытаюсь так:

function TForm2.Read(Path, Key: string): string;
var
 N, P, K, root: IXMLNode;
 ts: TStringList;
 i: integer;
 NodeAr: array of IXMLNode;
begin
 ts := TStringList.Create;
 ts.Delimiter := "/";
 ts.DelimitedText := Path;
 SetLength(NodeAr, ts.Count - 1); //-1 т.к первый элемент не использутеся
 root := XML.DocumentElement;
 if root.ChildNodes.IndexOf(ts[0]) >= 0 then
   NodeAr[0] := root.ChildNodes.FindNode(ts[0]) else begin Result := ""; exit; end;
 for I := 1 to ts.Count - 1 do begin
   NodeAr[i] := NodeAr[i - 1].ChildNodes.FindNode(ts[i]);
 end;
 K := NodeAr[Length(NodeAr)-1].ChildNodes.FindNode(Key);
 Result := K.NodeValue;
 ts.Free;
end;

---

← →
id   (2006-10-16 10:47) [6]

И ещё...
Сделать, чтоб XML сама создавала файл с описанием:

<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<root>
</root>

А то при записи в пустой файл - ошибка.

---

← →
Slym ©   (2006-10-16 10:47) [7]

function Read(const Path, Key: string): string;
var
 ts: TStringList;
 Node:IXMLNode;
 i:integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node:=XML.DocumentElement;
   for i:=0 to ts.Count-1 do
   begin
     if Node.ChildNodes.IndexOf(ts[i])<0 then
     begin
       result:="";
       exit;
     end;
     Node:=Node.ChildNodes.FindNode(ts[i]);
   end;
 finally
   ts.Free;
 end;
 if Node.ChildNodes.IndexOf(Key)<0 then
 begin
   result:="";
   exit;
 end;
 Node:=Node.ChildNodes.FindNode(Key);
 Result := Node.NodeValue;
end;

---

← →
Slym ©   (2006-10-16 10:50) [8]

Не проще так
function Read(const Key: string): string;
Где Key: "Main/Hello/Moto/Love/Test2"

---

← →
id   (2006-10-16 10:59) [9]

Slym, огромное спасибо.
Ответь пожалуйста по поводу файла. И ещё последняя маленькая проблемка у меня есть.
Как правильно создать TXMLDocument в run-time?
А то постоянно ошибка вылетает. Что надо сделать, кроме:
 XML.FileName := ExtractFilePath(Application.ExeName) + "1.xml";
 XML.Active := true;

---

← →
id   (2006-10-16 11:13) [10]

И можно-ли удалить определённую ветку, не удаляя весь файл XML.
Если да, то как?
А то не вижу у нода метода Delete или что-то с ним связанного.

---

← →
Slym ©   (2006-10-16 11:17) [11]

procedure CreateXML;
begin
 XML.Active := False;
 XML.XML.Text := "";
 XML.Active := True;
 XML.DocumentElement:= XMLDoc.CreateNode("xml");
 XML.Encoding:="UTF-8";
 XML.Version:="1.0";
 XML.StandAlone:="no";
end;

---

← →
Slym ©   (2006-10-16 11:21) [12]

Node.ChildNodes.Delete()

---

← →
id   (2006-10-16 11:25) [13]

Slym, да с удалением я тоже нашёл, догодавшись наконец-то полазить в справке.
НО функция такого вида:

procedure TForm2.Delete(Path: string);
var
 ts: TStringList;
 Node: IXMLNode;
 i: integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node := XML.DocumentElement;
   for i := 0 to ts.Count - 1 do
   begin
     if Node.ChildNodes.IndexOf(ts[i]) < 0 then
       exit;
     Node := Node.ChildNodes.FindNode(ts[i]);
   end;
   Node.ChildNodes.Delete(ts[i-1]);
 finally
   ts.Free;
 end;
end;

Не работает :\ Надо, чтоб она удаляла весь передавнный нод со всеми под нодами.

И в этом коде:

procedure TForm2.CreateXML;
var
XMLDoc: TXMLDocument;
begin
XML.Active := False;
XML.XML.Text := "";
XML.Active := True;
XML.DocumentElement:= XMLDoc.CreateNode("xml");
XML.Encoding:="UTF-8";
XML.Version:="1.0";
XML.StandAlone:="no";
XML.SaveToFile("3.xml");
end;

Вылетает ошибка:
Message: Access violation at address 00406E0D in module "Project2.exe". Read of address E8C58BF0.

Пожалуйста, помогите ещё раз. Это мой последний вопрос. Заранее крайне признателен Вам за помощь и выделенное время.

---

← →
Slym ©   (2006-10-16 11:27) [14]

ганю
procedure TForm2.CreateXML;
begin
XML.Active := False;
XML.XML.Text := "";
XML.Active := True;
XML.DocumentElement:= XML.CreateNode("xml");
XML.Encoding:="UTF-8";
XML.Version:="1.0";
XML.StandAlone:="no";
XML.SaveToFile("3.xml");
end;

---

← →
Slym ©   (2006-10-16 11:28) [15]

procedure TForm2.Delete(Path: string);
var
ts: TStringList;
Node: IXMLNode;
i: integer;
begin
ts := TStringList.Create;
try
  ts.Delimiter := "/";
  ts.DelimitedText := Path;
  Node := XML.DocumentElement;
  for i := 0 to ts.Count - 2 do
  begin
    if Node.ChildNodes.IndexOf(ts[i]) < 0 then
      exit;
    Node := Node.ChildNodes.FindNode(ts[i]);
  end;
  Node.ChildNodes.Delete(ts[ts.Count-1]);
finally
  ts.Free;
end;
end;

---

← →
id   (2006-10-16 11:33) [16]

Спасибо опять же громадное.

PS.  for i := 0 to ts.Count - 2 do я думал, что в этом коде ошибка может быть и не стал так делать.
Ведь если ts.Count будет 1 или 2, то от него ещё 2 будет отниматься.

Т.е. я так понимаю - такой код будет работать при любом переданном параметре?

PS2: Создание XML работает. Спасибо.

---

← →
id   (2006-10-16 12:01) [17]

Написал отдельный модуль для работы.
Но при записи ошибка: invalid pointer floating operation
Посмотри, пожалуйста,  в чём ошибка. Модуль:

unit XMLClass;

interface

uses
 SysUtils,
 Classes,
 XMLDoc,
 XMLIntf,
 xmldom,
 msxmldom;

type
 TXMLClass = object
   XML: TXMLDocument;
   Opened: boolean;
   fPath: string;
   procedure Open(Path: string; CreateIfNotExists: boolean = true);
   procedure Write(Path, Key, Value: string);
   function Read(Path, Key: string): string;
   procedure Delete(Path: string);
   procedure Close;
 end;

implementation

procedure TXMLClass.Open(Path: string; CreateIfNotExists: Boolean = True);
begin
 XML:=TXMLDocument.Create("");
 fPath := Path;
 Opened := false;
 if FileExists(Path) then
 begin
   XML.FileName := Path;
   XML.Options := [doNodeAutoIndent];
   XML.Active:=true;
   Opened := true;
   exit;
 end;
 XML.Active := False;
 XML.XML.Text := "";
 XML.Active := True;
 XML.DocumentElement := XML.CreateNode("xml");
 XML.Encoding := "UTF-8";
 XML.Version := "1.0";
 XML.StandAlone := "no";
 if CreateIfNotExists then
 begin
   XML.SaveToFile(Path);
   Opened := true;
 end
 else
 begin
   Opened := false;
   exit;
 end;
end;

procedure TXmlClass.Write(Path: string; Key: string; Value: string);
var
 Node: IXMLNode;
 ts: TStringList;
 i: integer;
begin
 ts := TStringList.Create;
 ts.Delimiter := "/";
 ts.DelimitedText := Path;
 Node := XML.DocumentElement;
 if Node.ChildNodes.IndexOf(ts[0]) < 0 then
   Node := Node.AddChild(ts[0]) else
   Node := Node.ChildNodes.FindNode(ts[0]);
 for I := 1 to ts.Count - 1 do begin
   if Node.ChildNodes.IndexOf(ts[i]) < 0 then
     Node := Node.AddChild(ts[i]) else Node := Node.ChildNodes.FindNode(ts[i]);
 end;
 Node := Node.AddChild(Key);
 Node.Text := Value;
 ts.Free;
end;

function TXmlClass.Read(Path: string; Key: string): string;
var
 ts: TStringList;
 Node: IXMLNode;
 i: integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node := XML.DocumentElement;
   for i := 0 to ts.Count - 1 do
   begin
     if Node.ChildNodes.IndexOf(ts[i]) < 0 then
     begin
       result := "";
       exit;
     end;
     Node := Node.ChildNodes.FindNode(ts[i]);
   end;
 finally
   ts.Free;
 end;
 if Node.ChildNodes.IndexOf(Key) < 0 then
 begin
   result := "";
   exit;
 end;
 Node := Node.ChildNodes.FindNode(Key);
 Result := Node.NodeValue;
end;

procedure TXmlClass.Delete(Path: string);
var
 ts: TStringList;
 Node: IXMLNode;
 i: integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node := XML.DocumentElement;
   for i := 0 to ts.Count - 2 do
   begin
     if Node.ChildNodes.IndexOf(ts[i]) < 0 then
       exit;
     Node := Node.ChildNodes.FindNode(ts[i]);
   end;
   Node.ChildNodes.Delete(ts[ts.Count - 1]);
 finally
   ts.Free;
 end;
end;

procedure TXMlClass.Close;
begin
 XML.SaveToFile(fPath);
end;

end.


---

← →
Плохиш ©   (2006-10-16 12:32) [18]

> procedure TXmlClass.Write(Path: string; Key: string; Value:
>  string);
> var
>  Node: IXMLNode;
>  ts: TStringList;
>  i: integer;
> begin
>  ts := TStringList.Create;
>  ts.Delimiter := "/";
>  ts.DelimitedText := Path;
>  Node := XML.DocumentElement;
>  if Node.ChildNodes.IndexOf(ts[0]) < 0 then
>    Node := Node.AddChild(ts[0]) else
>    Node := Node.ChildNodes.FindNode(ts[0]);
>  for I := 1 to ts.Count - 1 do begin
>    if Node.ChildNodes.IndexOf(ts[i]) < 0 then
>      Node := Node.AddChild(ts[i]) else Node := Node.ChildNodes.
> FindNode(ts[i]);
>  end;
>  Node := Node.AddChild(Key);
>  Node.Text := Value;
>  ts.Free;
> end;


procedure TXmlClass.Write(Path: string; Key: string; Value: string);
var
Node, Node1: IXMLNode;
ts: TStringList;
i: integer;
begin
ts := TStringList.Create;
try
  ts.Delimiter := "/";
  ts.DelimitedText := Path;
  Node := XML.DocumentElement;
  for i := 0 to ts.Count - 1 do
  begin
    Node1 := Node.ChildNodes.FindNode(ts[0]);
    if Node1 = nil then Node := Node.AddChild(ts[i])
    else Node := Node1;
  end;
  Node := Node.AddChild(Key);
  Node.Text := Value;
finally
  ts.Free;
end;
end;

PS.

>    XML.FileName := Path;
>    XML.Active:=true;

=

 XML.LoadFromFile(Path);

и проверка на исключения не помешает.

>  XML.DocumentElement := XML.CreateNode("xml");

=

 XML.AddChild("xml");


---

← →
Плохиш ©   (2006-10-16 12:34) [19]

Хм, забыл :-)

> id   (16.10.06 12:01) [17]
> Написал отдельный модуль для работы.
> Но при записи ошибка: invalid pointer floating operation

Надо бы ещё ткнуть пальцем в строчку, на которой ошибка возникает.

---

← →
_RusLAN ©   (2006-10-16 12:35) [20]

> [17] id   (16.10.06 12:01)

Почти все проблемы вы могли б решить сами с помощью дебагера.

---

← →
id   (2006-10-16 12:38) [21]

Если честно - не совсем понятно.
Брейкпоинт примерно тут срабатывает:
Это процедура Write

 Node := XML.DocumentElement;
 for i := 0 to ts.Count - 1 do
 begin
   Node1 := Node.ChildNodes.FindNode(ts[0]);
   if Node1 = nil then Node := Node.AddChild(ts[i]) //тут
   else Node := Node1;
 end;

---

← →
Плохиш ©   (2006-10-16 12:48) [22]

Может поможет:

var
....
  sChild: String;
.....
for i := 0 to ts.Count - 1 do
begin
  sChild := ts[i]
  Node1 := Node.ChildNodes.FindNode(sChild);
  if Node1 = nil then Node := Node.AddChild(sChild)
  else Node := Node1;
end;


---

← →
id   (2006-10-16 12:52) [23]

Дело в том, что до того, как я всё вынес в отдельный модуль - всё работало прекрасно.
Может что-то не так в процедуре OpenFile?

---

← →
Плохиш ©   (2006-10-16 15:57) [24]


unit XMLClass;

interface

uses
SysUtils, Classes, XMLDoc, XMLIntf, xmldom, msxmldom;

type
 TXMLClass = class(TComponent)
 private
   fPath: string;
   XML: TXMLDocument;
 public
   Opened: boolean;
   constructor Create(AFileName: String = ""); reintroduce; overload;
   procedure Open(AFileName: string; CreateIfNotExists: boolean = true);
   procedure Write(Path, Key, Value: string);
   function Read(Path, Key: string): string;
   procedure Delete(Path: string);
   procedure Close;
end;

implementation

constructor TXMLClass.Create(AFileName: String);
begin
 XML := nil;
 if AFileName <> "" then Open(AFileName, false);
end;

procedure TXMLClass.Open(AFileName: string; CreateIfNotExists: Boolean = True);
begin
 if XML <> nil then XML.Free;
 XML := TXMLDocument.Create(self);
 try
   XML.Options := [doNodeAutoCreate, doAttrNull, doAutoPrefix, doNamespaceDecl];
   XML.ParseOptions := [];
   XML.DOMVendor := GetDOMVendor("");
   fPath := AFileName;
   if FileExists(fPath) then
   begin
     XML.LoadFromFile(fPath);
   end
   else
   begin
     XML.XML.Clear;
     XML.Active := true;
     XML.Version := "1.0";
     XML.Encoding := "UTF-8";
     XML.StandAlone := "no";
     XML.AddChild("xml");
     if CreateIfNotExists then XML.SaveToFile(fPath);
   end;
   Opened := true;
 except
   XML.Free;
   XML := nil;
   Opened := false;
   raise;
 end;
end;

procedure TXmlClass.Write(Path: string; Key: string; Value: string);
var
   Node, Node1: IXMLNode;
   ts: TStringList;
   i: integer;
begin
 ts := TStringList.Create;
 try
   ts.Delimiter := "/";
   ts.DelimitedText := Path;
   Node := XML.DocumentElement;
   for i := 0 to ts.Count - 1 do
   begin
     Node1 := Node.ChildNodes.FindNode(ts[i]);
     if Node1 = nil then Node := Node.AddChild(ts[i])
     else Node := Node1;
   end;
   Node1 := Node.ChildNodes.FindNode(Key);
   if Node1 = nil then Node1 := Node.AddChild(Key);
   Node1.NodeValue := Value;
 finally
   ts.Free;
 end;
end;

function TXmlClass.Read(Path: string; Key: string): string;
var
ts: TStringList;
Node: IXMLNode;
i: integer;
begin
Result := "";
ts := TStringList.Create;
try
  ts.Delimiter := "/";
  ts.DelimitedText := Path;
  Node := XML.DocumentElement;
  for i := 0 to ts.Count - 1 do
    if Node = nil then break
    else Node := Node.ChildNodes.FindNode(ts[i]);
  if Node <> nil then Node := Node.ChildNodes.FindNode(Key);
finally
  ts.Free;
end;
if Node <> nil then Result := Node.NodeValue;
end;

procedure TXmlClass.Delete(Path: string);
var
ts: TStringList;
Node: IXMLNode;
i: integer;
begin
ts := TStringList.Create;
try
  ts.Delimiter := "/";
  ts.DelimitedText := Path;
  Node := XML.DocumentElement;
  for i := 0 to ts.Count - 2 do
    if Node = nil then break
    else Node := Node.ChildNodes.FindNode(ts[i]);
  if Node <> nil then Node.ChildNodes.Delete(ts[ts.Count - 1]);
finally
  ts.Free;
end;
end;

procedure TXMlClass.Close;
begin
XML.SaveToFile(fPath);
end;

end.


---

← →
id   (2006-10-16 16:02) [25]

Это полностью проверенное и рабочее?
Спасибо огромное за старания.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2006.11.26;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.54 MB
Время: 0.036 c