Выполнение SQL-запроса к объекту соединения с ADO

(defun ru-ado-exec-sql (connection_object
                        sql
                        /
                        command_object
                        fields_object
                        field_count
                        field_list
                        field_number
                        is_error
                        item
                        records_affected
                        record_set_list
                        record_set_object
                        result
                        temp_object

                       )
  (setq command_object (vlax-create-object "ADODB.Command"))
  (vlax-put-property command_object "CommandText" sql)
  (vlax-put-property command_object "ActiveConnection" connection_object)
  (setq record_set_object (vlax-create-object "ADODB.RecordSet"))
  ;; Открываем набор данных   и пытаемся выловить ошибки
  (if (vl-catch-all-error-p
        (setq temp_object
               (vl-catch-all-apply
                 'vlax-invoke-method
                 (list command_object
                       "Execute"
                       'records_affected
                       nil
                       ru-ado-const-adcmdtext
                 ) ;_ end of list
               ) ;_ end of vl-catch-all-apply
        ) ;_ end of setq
      ) ;_ end of vl-catch-all-error-p
    (progn
;;; В случае сбойной ситуации выводим сообщение об ошибках
      (ru-ado-error-messages
        (ru-ado-error-handler temp_object connection_object)
        sql
      ) ;_ end of ru-ado-error-messages
      (setq is_error t)
      (vlax-release-object command_object)
      (vlax-release-object record_set_object)
    ) ;_ end of progn
    (setq record_set_object temp_object)
  ) ;_ end of if
;;; Если ошибок нет, обрабатываем данные
  (if (not is_error)
    ;; Если набор закрыт
    (if (= ru-ado-const-adstateclosed
           (vlax-get-property record_set_object "State")
        ) ;_ end of =
      ;; Закрытый набор остается при SQL-запросах,
      ;; содержащих  DELETE, INSERT или UPDATE
      ;; Записи при этом не возвращаются и можно
      ;; удалить объекты
      (progn
        (setq result records_affected)
        (vlax-release-object record_set_object)
        (vlax-release-object command_object)
      ) ;_ end of progn
      (progn
       ;| Для запросов SELECT вытаскиваем данные полей.
Получаем свойство Fields, и количество полей.
Теперь значения полей нужно преобразовать в список. В Delphi мы легко
получали значение любого поля, в LISP это сложнее.

|;
        (setq fields_object
                            (vlax-get-property record_set_object "Fields")
              field_count
                            (vlax-get-property fields_object "Count")
              field_number  -1
        ) ;_ end of setq
        ;; Составляем список отобранных полей
        (while (> field_count (setq field_number (1+ field_number)))
;;; Составляем список всех полей
          (setq
            field_list
             (cons
               (vlax-get-property
                 (vlax-get-property fields_object "Item" field_number)
                 "Name"
               ) ;_ end of vlax-get-property
               field_list
             ) ;_ end of cons
          ) ;_ end of setq
        ) ;_ end of while

        (setq result (list (reverse field_list)))
        ;; составили список имен полей
        ;; Если записей несколько
        (if (not (and (= :vlax-true
                         (vlax-get-property record_set_object "BOF")
                      ) ;_ end of =
                      (= :vlax-true
                         (vlax-get-property record_set_object "EOF")
                      ) ;_ end of =
                 ) ;_ end of and
            ) ;_ end of not
          (setq
            result
;;; Сначала добавляем в результат список имен полей

             (append (list (reverse field_list))
;;; Затем добавляем список значений
                     ;|
Здесь мы используем функцию транспонирования списка
по алгоритму Дугласа Вильсона (Douglas Wilson)
 http://xarch.tu-graz.ac.at/autocad/lisp/
для создания списка записей, так как

GetRows возвращает набор данных в виде
(
(ПОЛЕ1_ЗАПИСЬ1 ПОЛЕ1_ЗАПИСЬ2...ПОЛЕ1_ЗАПИСЬХ)
(ПОЛЕ2_ЗАПИСЬ1 ПОЛЕ2_ЗАПИСЬ2...ПОЛЕ2_ЗАПИСЬХ)
(ПОЛЕХ_ЗАПИСЬ1 ПОЛЕХ_ЗАПИСЬ2...ПОЛЕХ_ЗАПИСЬХ)
)
А нам надо в виде

(
(ПОЛЕ1_ЗАПИСЬ1 ПОЛЕ2_ЗАПИСЬ1... ПОЛЕХ_ЗАПИСЬ1)
(ПОЛЕ1_ЗАПИСЬ2 ПОЛЕ2_ЗАПИСЬ2... ПОЛЕХ_ЗАПИСЬ2)
(ПОЛЕ1_ЗАПИСЬХ ПОЛЕ2_ЗАПИСЬХ... ПОЛЕХ_ЗАПИСЬХ)
)

|;
                     (ru-list-Douglas-Wilson-transpose
                       (mapcar
                         (function(lambda (record_set_list)
                            (mapcar '(lambda (item)
                                       (ru-ado-variant-to-value item)
                                     ) ;_ end of lambda
                                    record_set_list
                            ) ;_ end of mapcar
                          ) ;_ end of lambda
                          )
                         (vlax-safearray->list
                           (vlax-variant-value
                             (vlax-invoke-method
                               record_set_object
                               "GetRows"
                               ru-ado-const-adgetrowsrest
                             ) ;_ end of vlax-invoke-method
                           ) ;_ end of vlax-variant-value
                         ) ;_ end of vlax-safearray->list
                       ) ;_ end of mapcar
                     ) ;_ end of ru-list-Douglas-Wilson-transpose
             ) ;_ end of append
          ) ;_ end of setq
        ) ;_ end of if
        (vlax-invoke-method record_set_object "Close")
        (vlax-release-object record_set_object)
        (vlax-release-object command_object)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of if
  result
) ;_ end of defun