Отправляет email-рассылки с помощью сервиса Sendsay

Создание САПР на базе продуктов Autodesk

Подписаться Бесплатная новостная рассылка Временно не выходит ,возобновит выход в начале сентября Подписчиков 175 RSS
←   Март 2004   →
 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


За последние 60 дней ни разу не выходила


Сайт рассылки: http://caddev.narod.ru
Открыта: 23-02-2004

Автор
С.С. Калугин

Статистика

175 подписчиков
0 за неделю
←   Все выпуски   →

Создание САПР на базе продуктов Autodesk


Информационный Канал Subscribe.Ru

Информационная рассылка сайта CadDev.Narod.Ru

(с) 2004, Калугин Сергей Сергеевич

Сегодня в выпуске

Дорогие женщины!

Поздравляем Вас с 8 марта, Международным женским днём!

Любви и счастья, света и тепла,
Здоровья, радости и красоты!
Успешно пусть идут у Вас дела
И сбудутся заветные мечты!

Информация для студентов

В разделе "Лабы" появилось задание для выполнения Лабораторной работы №3.

Пример использования Microsoft ActiveX Data Objects (ADO) для доступа к базе данных Microsoft Access

Инициализация методов интерфейса ADO, используя библиотеку типов

(defun DbInitADO ( / ADO_DLLPath)
  (if (null adom-Append)
    (progn

      ;; Если используется NT платформа, то необходимо
      ;; жестко прописать путь к библиотеке (рекомендация)


      (setq ADO_DLLPath
        (strcat (getenv "systemdrive")
        "\\Program Files\\Common Files\\System\\Ado\\")
      )

      ;; Если мы нашли библиотеку ...

      (if (findfile (strcat ADO_DLLPath "msado15.dll"))

        ;; Импортируем её

        (vlax-Import-Type-Library
          :tlb-filename   (strcat ADO_DLLPath "msado15.dll")
          :methods-prefix    "adom-"
          :properties-prefix "adop-"
          :constants-prefix  "adok-"
        )
        ;; Если не находим - сообщаем пользователям
        (alert (strcat "Cannot find\n" ADO_DLLPath "msado15.dll"))
      )
    )
  )
)

Создаем присоединение к MS-Access или MS-SQL Server Databases

;;;****************************************************************************
;;; Присоединение к MS-Access Database с использованием ODBC (не требуется DSN)
;;; Например, (DbConnect_MSAccess1 "d:/dbfiles/products.mdb")
;;;****************************************************************************

(defun DbConnect_MSAccess1 (dbFile)
  (strcat
    "Provider=MSDASQL;"
    "Driver={Microsoft Access Driver (*.mdb)};"
    "DBQ=" dbFile
  )
)

;;;******************************************************************
;;; Присоединение к MS-Access Database используя JET 3.51
;;; Например, (DbConnect_MSAccess2 "d:/dbfiles/products.mdb")
;;;******************************************************************

(defun DbConnect_MSAccess2 (dbFile)
  (strcat
    "Provider=Microsoft.Jet.OLEDB.3.51;"
    "Data Source=" dbFile
  )
)

;;;******************************************************************
;;; Присоединение к MS-SQL Database используя ODBC (без DSN)
;;; Например, (DbConnect_MSSQL1 "SQLSERVER1" "products" "sa" "")
;;;******************************************************************

(defun DbConnect_MSSQL1 (dbServer dbName dbUser dbPassword)
  (strcat
    "Provider=SQLOLEDB;"
    "Driver={SQL Server};"
    "Server=" dbServer ";"
    "Database=" dbName ";"
    "UID=" dbUser ";"
    "PWD=" dbPassword
  )
)

;;;******************************************************************
;;; Присоединение к MS-SQL Database без использования ODBC
;;; Например, (DbConnect_MSSQL2 "SQLSERVER2" "pr_catalog1" "sa" "")
;;;******************************************************************

(defun DbConnect_MSSQL2 (dbServer dbCatalog dbUser dbPassword)
  (strcat
    "Provider=SQLOLEDB;"
    "Data Source=" dbServer ";"
    "Initial Catalog=" dbCatalog ";"
    "User ID=" dbUser ";"
    "Password=" dbPassword
  )
)

Создаем SQL запрос для разных случаев
(colName и Value должны быть не nil или иметь значения)

(defun DbSQLCommand (tblName colName Value)
  (cond
    ( (and colName value (= (type value) 'STR))
      (strcat "SELECT * FROM " tblName " WHERE " colName " = '" Value "'")
    )
    ( (and colName value (= (type value) 'INT))
      (strcat "SELECT * FROM " tblName " WHERE " colName " = " (itoa Value) )
    )
    ( (and colName value (= (type value) 'REAL))
      (strcat "SELECT * FROM " tblName " WHERE " colName " = " (itoa (fix Value)) )
    )
    ( T (strcat "SELECT * FROM " tblName ) )
  ); cond
)

Выгружаем объекты VLA из памяти

(defun MxRelease (xObject)
  (if (not (vlax-object-release-p xObject))
    (vlax-Release-Object xObject)
  )
)

Закрываем ADO Connection Object и освобождаем память

(defun DbCloseConnection (dbConnObject)
  (vlax-Invoke-Method dbConnObject "Close")
  (MxRelease dbConnObject)
)

Закрываем ADO RecordSet Object и освобождаем память

(defun DbCloseRecordset (rsObject)
  (vlax-Invoke-Method rsObject "Close")
  (MxRelease rsObject)
)

Проверяем, закрыт ли RecordSet (возвращает T или nil)

(defun DbRsIsClosed (rsObject)
  (= adok-adStateClosed (vlax-Get-Property rsObject "State"))
)

Возвращаем число записей в ADO RecordSet Object

(defun DbRsCount (rsObject)
  (vlax-Get-Property rsObject "RecordCount")
)

Возвращает имена полей из Field Object и колическтво полей

(defun DbGetFields (fObject fCount / FieldNumber)
  (setq FieldNumber -1)

  (while (> fCount (setq FieldNumber (1+ FieldNumber)))
    (setq FieldList
      (cons
        (vlax-Get-Property 
          (DbRsFieldItem FieldsObject FieldNumber) "Name"
        )
        FieldList
      )
    ); setq
  ); end while
); defun

Возвращает ADO Field object (поле) из RecordSet Object

(defun DbRsFields (rsObject)
  (vlax-Get-Property rsObject "Fields")
)

Возвращает количество полей от принимаемого Field Object

(defun DbRsFieldCount (fObject)
  (vlax-Get-Property fObject "Count")
)

Получить имя поля (Item) из Field Object

(defun DbRsFieldItem (fObject fNumber)
  (vlax-Get-Property fObject "Item" fNumber)
)

Возвращает объект RowSet из RecordSet object

(defun DbRsGetRows (rsObject)
  (vlax-Invoke-Method rsObject "GetRows" adok-adGetRowsRest)
)

Применяет ADO Cursor Type получаемого RecordSet Object

(defun DbRsCursorType (rsObject curType)
  (cond
    ( (= (strcase curType) "KEYSET")
      (vlax-Put-Property rsObject "CursorType" adok-adOpenKeyset)
    )
    ( (= (strcase curType) "DYNAMIC")
      (vlax-Put-Property rsObject "CursorType" adok-adOpenDynamic)
    )
  )
)

Применяет ADO Lock Type получаемого RecordSet Object

(defun DbRsLockType (rsObject lockType)
  (cond
    ( (= (strcase lockType) "OPTIMISTIC")
      (vlax-Put-Property rsObject "LockType" adok-adLockOptimistic)
    )
    ( (= (strcase lockType) "BATCHOPTIMISTIC")
      (vlax-Put-Property rsObject "LockType" adok-adLockBatchOptimistic)
    )
    ( (= (strcase lockType) "READONLY")
      (vlax-Put-Property rsObject "LockType" adok-adLockReadOnly)
    )
  )
)

Создает и возвращает ADO Connection object

(defun DbConnection ()
  (vlax-Create-Object "ADODB.Connection")
)

Создает и возвращает ADO RecordSet object

(defun DbRecordSet ()
  (vlax-Create-Object "ADODB.RecordSet")
)

Функция собирвает все ошибки в список ("name" . "value")

(defun ErrorProcessor
  (VLErrorObject ConnectionObject / ErrorsObject
    ErrorObject ErrorCount ErrorNumber ErrorList
    ErrorValue
  )

  ;; Вначале получает сообщение об ошибке Visual LISP

  (setq ReturnList
        (list
          (list
            (cons "Сообщение Visual LISP"
            (vl-Catch-All-Error-Message VLErrorObject)
          )
        )
      )
      ;; Получаем ошибки объекта ADO и их количество

        ErrorObject  (vlax-Create-object "ADODB.Error")
        ErrorsObject  (vlax-Get-Property ConnectionObject "Errors")
        ErrorCount   (vlax-Get-Property ErrorsObject "Count")
        ErrorNumber -1
  )

  ;; Цикл через все ошибки ADO ...
  (while (< (setq ErrorNumber (1+ ErrorNumber)) ErrorCount)

      ;; Получаем ссылку на объект текущей ошибки
      (setq ErrorObject (vlax-Get-Property ErrorsObject "Item" ErrorNumber)
            ErrorList nil ;; Очищаем список элементов этой ошибки
      )

    ;; Цикл через все возможные элементы ошибок данной ошибки
    (foreach ErrorProperty
        '("Description" "HelpContext" "HelpFile"
          "NativeError" "Number" "SQLState" "Source"
         )
      ;; Получаем значение текущего элемента. Если это число ......
      (if 
        (numberp
          (setq ErrorValue
            (vlax-Get-Property ErrorObject ErrorProperty)
        ))
        ;; Преобразуем в строку
        (setq ErrorValue (itoa ErrorValue))
      )
      ;; И добавляем в список
      (setq ErrorList (cons (cons ErrorProperty ErrorValue) ErrorList))
    ); end foreach

    ;; Добавляем список для текущей ошибки и возвращаем значениеvalue
    (setq ReturnList (cons (reverse ErrorList) ReturnList))
  ); end while

  ;; Устанавливаем возвращемеое значение в правильном порядке
  (reverse ReturnList)

); defun

Выводит список ошибок, сгенерированный функцией ErrorProcessor function. Функция ErrorProcessor должна вызываться, котгда используются диалоги DCL и ErrorPrinter после показа диалогового окна.

(defun ErrorPrinter (ErrorsList)
  (foreach ErrorList ErrorsList
    (prompt "\n")
    (foreach ErrorItem ErrorList
      (prompt (strcat (car ErrorItem) "\t\t" (cdr ErrorItem) "\n") )
    )
  )
  (prin1)
)

 

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное