|
<<
Назад
Пример использования 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)
)
<<
Назад
Чтобы быть в курсе всех событий, получения
необходимой и интересной информации, подпишись на рассылку "Создание
САПР на базе продуктов Autodesk"
|
