Работа с xml, часть 2

В предыдущей части была рассмотрена работа с объектом xml-документа. Продолжим?

А куда ж мы денемся...

Опять же, публикую библиотечные функции:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(defun _kpblc-property-get (obj property / res)
                           ;|
*    Получение значения свойства объекта
|;

  (_kpblc-error-catch
    (function
      (lambda ()
        (if (and obj
                 (vlax-property-available-p
                   (setq obj (_kpblc-conv-ent-to-vla obj))
                   property
                   ) ;_ end of vlax-property-available-p
                 ) ;_ end of and
          (setq res (vlax-get-property obj property))
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    nil
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

(defun _kpblc-xml-conv-nodes-to-list (nodes / i res)
                                     ;|
*    Преобразование указателя на коллекцию Nodes xml-объекта в список.
*    Исключаются описания не узлов (комментарии, DATA-узлы и т.п.)
*    Параметры вызова:
 nodes указатель на коллекцию узлов xml-документа
|;

  (_kpblc-error-catch
    (function
      (lambda ()
        (setq i 0)
        (while (< i (_kpblc-property-get nodes 'length))
          (setq res (cons (vlax-get-property nodes 'item i) res)
                i   (1+ i)
                ) ;_ end of setq
          ) ;_ end of while
        (setq res (vl-remove-if-not
                    (function
                      (lambda (x)
                        (member (_kpblc-property-get x 'nodetype) '(1 2))
                        ) ;_ end of lambda
                      ) ;_ end of function
                    (reverse res)
                    ) ;_ end of vl-remove-if-not
              ) ;_ end of setq
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x)
       (_kpblc-error-print "_kpblc-xml-conv-nodes-to-list" x)
       (setq res nil)
       ) ;_ end of lambda
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

У любого правильно сделанного (или "валидного") xml-документа обязательно есть так называемый "главный", или "прародительский" узел. И такой узел может быть только один.

Его тоже можно прочитать:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
(defun _kpblc-xml-node-get-main (obj / res)
                                ;|
*    Получение главного (верхнего) узла xml-дерева. Валидность xml-файла не
* проверяется
*    Параметры вызова:
 obj указатель на объект XML-документа
*    Примеры вызова:
(setq obj (_kpblc-xml-doc-get (findfile (strcat (_kpblc-dir-path-and-splash(_kpblc-dir-get-root-xml))"tables.xml"))))
(_kpblc-xml-node-get-main obj)
|;

  (_kpblc-error-catch
    (function
      (lambda ()
        (setq res (car (_kpblc-xml-conv-nodes-to-list
                         (_kpblc-property-get
                           obj
                           'childnodes
                           ) ;_ end of _kpblc-property-get
                         ) ;_ end of _kpblc-xml-conv-nodes-to-list
                       ) ;_ end of car
              ) ;_ end of setq
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x)
       (_kpblc-error-print "_kpblc-xml-node-get-main" x)
       (setq res nil)
       ) ;_ end of lambda
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

Все остальные узлы являются подчиненными - либо главному узлу, либо другим узлам. Их можно считывать:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defun _kpblc-xml-nodes-get-child (parent / node childs res)
                                  ;|
*    Получение подчиненных элементов xml-дерева
*    Параметры вызова
 parent указатель на узел, для которого получаем Child
  nil недопустим
*    Примеры вызова:
(setq obj (_kpblc-xml-get-document (findfile (strcat (_kpblc-dir-path-and-splash(_kpblc-dir-get-root-xml))"tables.xml"))))
(_kpblc-xml-get-nodes-child (_kpblc-xml-node-get-main obj))
|;

  (if (and parent
           (vlax-method-applicable-p parent 'haschildnodes)
           (equal (vlax-invoke-method parent 'haschildnodes)
                  :vlax-true
                  ) ;_ end of equal
           (setq childs (_kpblc-property-get parent 'childnodes))
           ) ;_ end of and
    (_kpblc-xml-conv-nodes-to-list childs)
    ) ;_ end of if
  ) ;_ end of defun

Или записывать:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(defun _kpblc-xml-node-add-child (parent tag save / res)
                                 ;|
*    Добавление подчиненного узла
*    Параметры вызова:
 parent указатель на родительский узел, в который и выполняется добавление
 tag тэг нового узла
 save выполнять или нет сохранение документа для parent'a
|;

  (_kpblc-error-catch
    (function
      (lambda ()
        (setq res (vlax-invoke-method
                    parent
                    'appendchild
                    (vlax-invoke-method
                      (_kpblc-xml-doc-get-by-node parent)
                      'createelement
                      tag
                      ) ;_ end of vlax-invoke-method
                    ) ;_ end of vlax-invoke-method
              ) ;_ end of setq
        (if save
          (_kpblc-xml-doc-save (_kpblc-xml-doc-get-by-node node))
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x)
       (_kpblc-error-print "_kpblc-xml-node-add-child" x)
       (setq res nil)
       ) ;_ end of lambda
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

Но узлы узлами, а в xml существует еще понятие тэгов, атрибутов и текстов :) С этим чуть позже.

Размещено в Код LISP, Среда разработки, Функции LISP · Метки:



Поделитесь своим мнением


Я не робот.