Класс для работы с XML документами

Краткое содержание

XmlDoc.Root        // Корневой элемент XML-документа
XmlDoc.Load()      // Загрузить XML-документ из строки
XmlDoc.Save()      // Сохранить XML-документ в строку

XmlNode.Name       // Имя узла
XmlNode.Params     // Параметры узла
XmlNode.Childs     // Вложенные узлы
XmlNode.Text       // Текст между тегами
XmlNode.Append()   // Добавить ребенка
XmlNode.SetParam() // Установить параметр узла
XmlNode.GetParam() // Получить параметр узла
XmlNode.Get()      // Получить первый узел с определенным именем
XmlNode.Get1()     // Получить первый узел с определенным именем и параметрами              

Meta.XmlDoc        // Загруженная программа
Meta.Save()        // Сохранение программы

Класс XmlDoc. XML-документ.

// Корневой элемент XML-документа
Var Root : XmlNode;

// Загрузить XML-документ из строки.
// Broken - это нестандартный формат XML применяющийся в таблице __easycontrol
Procedure Load(Str : String; Broken : Boolean);
Begin
  Root := CreateModule('XmlNode').Load(CreateXml(Str, Broken));
End;

// Сохранить XML-документ в строку
Function Save(Broken : Boolean) : String;
Begin
  Result := If(Broken, SaveBroken(), SaveNormal());
End;

Function SaveBroken() : String;
Var
  X : XmlWriterBroken;
Begin
  Root.Save(X);
  Result := X.GetResult;
End;

Function SaveNormal() : String;
Var
  X : XmlWriter;
Begin
  Root.Save(X);
  Result := X.GetResult;
End;

Класс XmlNode. Узел XML-документа.

Type
  Param = Record Name, Value : String; End;
          
Var
  Name : String;             // Имя узла
  Params : Array Of Param;   // Параметры узла
  Childs : Array Of XmlNode; // Вложенные узлы
  Text : String;             // Текст между тегами

// Этот метод используется в XmlDoc.Load
Function Load(X : Xml) : XmlNode;
Var
  C : Xml;
  I : Integer;
Begin
  Name := X.Name;
  Text := X.Text;
  
  If Length(StrReplace([' ',Chr(10), Chr(13)], '', Text))=0 Then
    Text := '';
  
  Params.Count := X.PropCount;
  For i:=0 To Params.Count-1 Do
  Begin
    Params[i].Name  := X.PropName(i);
    Params[i].Value := X.Prop(i);
  End;
                
  C := X.Childs;
  While C.Fetch Do
    Append().Load(C);
    
  Result := Self;
End;

// Добавить ребенка
Function Append : XmlNode;
Begin
  Result := CreateModule('XmlNode');
  Childs.Append(Result);
End;

// Этот метод используется в XmlDoc.Save
Procedure Save(X : Variant);
Begin
  X.Open(Name);
  Foreach E In Params Do
    X.Prop(E.Name, E.Value);
  If Text<>'' Then X.Text(Text);
  Foreach E In Childs Do
    E.Save(X);
  X.Close(Name);
End;

// Установить параметр узла
Procedure SetParam(Name, Value : String);
Var
  P : XmlNode.Param;
Begin
  Foreach E In Params Do
    If 0 = CompareText(E.Name, Name) Then
    Begin
      E.Value := Value;
      Exit;
    End;
  P.Name  := Name;
  P.Value := Value;
  Params.Append(P);
End;

// Получить параметр узла
Function GetParam(Name : String) : String;
Begin
  Foreach E In Params Do
    If 0 = CompareText(E.Name, Name) Then
    Begin
      Result := E.Value;
      Exit;
    End;
End;

// Получить первый узел с определенным именем.
Function Get(Name : String) : XmlNode;
Begin
  Result := Get1(Name, ['']);
End;

// Получить первый узел с определенным именем и параметрами              
Function Get1(Name : String; Params : Array Of String) : XmlNode;
Var
  I : Integer;
Begin
  Foreach E In Childs Do
  Begin
    If 0 = CompareText(E.Name, Name) Then
    Begin
      i := 0;
      While True Do
      Begin
        If i+1>=Params.Count Then Begin Result := E; Exit; End;
        If 0<>CompareText(E.GetParam(Params[i]), Params[i+1]) Then Break;
        i := i+2;
      End;
    End;
  End;
  Raise('Узел '+Name+' ['+ToStr(Params)+'] не найден');
End;

Класс Meta. Программа.

// Загруженная программа
Var XmlDoc : XmlDoc;
  
Procedure OnCreate;
Begin
  XmlDoc := CreateModule('XmlDoc');
  XmlDoc.Load(DirectQuery('Select Cast(Data As Char) From __EasyControl Where Code=1')[0,0] as string, True);
End;

// Сохранение программы
Procedure Save;
Begin
  LoadPatchFromString(XmlDoc.SaveBroken);
End;

Пример работы с вышеперечисленными классами.

Var
  M : Meta;
  
Procedure OnCreate; 
Var
  TblName, RefName : String;
Begin
  // Загружаем программу
  M := CreateModule('Meta');
  
  // Придумываем имя для новых модулей
  TblName := 'Table'+ToStr(Random(100000000));
  RefName := TblName + 'Reference';
  
  // Создаем модули
  CreateTable(TblName);
  CreateReference(TblName, RefName);
  AddMenuItem(RefName);
  
  // Выводим отладочную информацию
  Dump('', M.XmlDoc.Root);

  // Сохраняем программу
  M.Save;
End;

Procedure AddMenuItem(Name : String);
Var
  NewMenuItem : XmlNode;
Begin
  // Добавляем новый узел в "menu1.load_xls/Menu/Импорт из Excel"
  NewMenuItem := M.XmlDoc.Root.Get1('Module', ['Type','MainMenu','Name','menu1.load_xls'])
                                  .Get('Menu')
                                  .Get1('Popup', ['Text','Импорт из Excel'])
                                  .Append;

  // Заполняем параметры нового узла
  NewMenuItem.Name := 'Item';
  NewMenuItem.SetParam('Command', Name);
  NewMenuItem.SetParam('Text', 'Вызов '+Name);
End;
  
Procedure CreateReference(TblName, RefName : String);
Var
  R : XmlNode;
Begin
  R := M.XmlDoc.Root.Append;
  R.Name := 'Module';
  R.SetParam('Type', 'Reference');
  R.SetParam('Name', RefName);
  R.SetParam('Description', 'Справочник для '+TblName);
  R.SetParam('TopHeight', '16');
  R.SetParam('Fields', '64'+Chr(10)+'Наименование'+Chr(10)+'Name'+Chr(10)+'String');
End;

Procedure CreateTable(Name : String);
Var
  T, A, F : XmlNode;
Begin
  T := M.XmlDoc.Root.Append;
  T.Name := 'Module';
  T.SetParam('Type', 'Table');
  T.SetParam('Name', Name);
  T.SetParam('Description', 'Новая таблица '+Name);
  
  A := T.Append;
  A.Name := 'Fields';
  A.SetParam('CounterFieldUsed', '1');
  A.SetParam('PrimaryKeyField', 'Id');
  A.SetParam('DescriptionField', 'Name');

  F := A.Append;
  F.Name := 'Field';
  F.SetParam('Name', 'Id');
  F.SetParam('Description', 'Код');
  F.SetParam('Type', 'Integer');

  F := A.Append;
  F.Name := 'Field';
  F.SetParam('Name', 'Name');
  F.SetParam('Description', 'Наименование');
  F.SetParam('Type', 'String');
  F.SetParam('Min', '1');
  F.SetParam('Max', '100');
End;
      
// Вывод программы в окно предупреждений. Полезно для понимания структуры программы.
Procedure Dump(L : String; N : XmlNode);
Var
  S : String;
Begin
  Foreach E In N.Params Do
  Begin
    S := S + If(S='', ' (' , ', ');
    S := S + E.Name + '="' + StrReplace(Chr(10), '', E.Value) + '"';
  End;
  If S<>'' Then S := S + ')';
  
  Warning(L+N.Name+S);
  
  Foreach E In N.Childs Do
    Dump(L+'  ', E);
End;

© RTIT