| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

XML as Registry [D6, D7, NT4, Win2k, WinXP]

Страницы:   < 1 2 >

id ©   (2006-10-16 09:59:00) 

Необходимо работать с 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>

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

---

id   (2006-10-16 16:02:00) [1]

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

---

Плохиш   (2006-10-16 15:57:00) [2]


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 12:52:00) [3]

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

---

Плохиш   (2006-10-16 12:48:00) [4]

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

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:38:00) [5]

Если честно - не совсем понятно.
Брейкпоинт примерно тут срабатывает:
Это процедура 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;

---

_RusLAN   (2006-10-16 12:35:00) [6]

> [17] id   (16.10.06 12:01)

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

---

Плохиш   (2006-10-16 12:34:00) [7]

Хм, забыл :-)

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

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

---

Плохиш   (2006-10-16 12:32:00) [8]

> 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');


---

id   (2006-10-16 12:01:00) [9]

Написал отдельный модуль для работы.
Но при записи ошибка: 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.


---

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

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

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

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

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

---

Slym   (2006-10-16 11:28:00) [11]

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 - 2do
  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;

---

Slym   (2006-10-16 11:27:00) [12]

ганю
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;

---

id   (2006-10-16 11:25:00) [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:21:00) [14]

Node.ChildNodes.Delete()

---

Slym   (2006-10-16 11:17:00) [15]

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;

---

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

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

---

id   (2006-10-16 10:59:00) [17]

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

---

Slym   (2006-10-16 10:50:00) [18]

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

---

Slym   (2006-10-16 10:47:00) [19]

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;

---

id   (2006-10-16 10:47:00) [20]

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

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

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

---

Страницы:   < 1 2 >

Наверх