AUTOLISP→ACCESS
请问各位大侠AUTPLISP程序是如何和ACCESS连接的啊。这是我毕业设计里的其中一个项目，我现在是已经把LISP程序和ACCESS数据库都建好。就是不知道它们之间是怎么连接的，还请各位知道的大侠告诉老弟一下。 以前没有接触过这方面的内容。给你找了点资料，希望对你有用处。Visual LISP中使用ADO接口与MS-Access相连接
在Visual LISP中使用Microsoft ActiveX Data Objects (ADO)接口与MS-Access和
SQL Server相连接的例子。
通过类型库初始化ADO接口方法：
(defun DbInitADO ( / ADO_DLLPath)
(if (null adom-Append)
(progn
;; 尽管你可以把绝对路径输入到这里，但利用系统查找到的系统
;; 文件夹将会更加合理，可以避免不必要的错误。
(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-"
roperties-prefix "adop-"
:constants-prefix"adok-"
)
;; 找不到时，则通知操作者
(alert (strcat "不能找到以下文件\n" ADO_DLLPath "msado15.dll"))
)
)
)
)
生成MS-Access 或 MS-SQL Server 数据库的连接字符串
;;;******************************************************************
;;; 使用ODBC(不需要DSN)连接MS-Access数据库
;;; 示例： (DbConnect_MSAccess1 "d:/dbfiles/products.mdb")
;;;******************************************************************
(defun DbConnect_MSAccess1 (dbFile)
(strcat
"Provider=MSDASQL;"
"Driver={Microsoft Access Driver (*.mdb)};"
"DBQ=" dbFile
)
)
;;;******************************************************************
;;; 使用JET 3.51连接MS-Access数据库
;;; 示例： (DbConnect_MSAccess2 "d:/dbfiles/products.mdb")
;;;******************************************************************
(defun DbConnect_MSAccess2 (dbFile)
(strcat
"Provider=Microsoft.Jet.OLEDB.3.51;"
"Data Source=" dbFile
)
)
;;;******************************************************************
;;; 使用ODBC(不需要DSN)连接MS-SQL数据库
;;; 示例： (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
)
)
;;;******************************************************************
;;; 使用ODBC连接MS-SQL数据库w/o
;;; Ex. (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或有值。如果Value为REAL、INT或STR，它可以计算到适
当的值中来取得正确的查询语法
(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 对象并将内存释放出来
(defun DbCloseConnection (dbConnObject)
(vlax-Invoke-Method dbConnObject "Close")
(MxRelease dbConnObject)
)
关闭ADO RecordSet对象并将内存释放出来
(defun DbCloseRecordset (rsObject)
(vlax-Invoke-Method rsObject "Close")
(MxRelease rsObject)
)
布尔测试RecordSet 是否为 Closed (T 或 nil)
(defun DbRsIsClosed (rsObject)
(= adok-adStateClosed (vlax-Get-Property rsObject "State"))
)
返回一个ADO RecordSet对象中的记录数
(defun DbRsCount (rsObject)
(vlax-Get-Property rsObject "RecordCount")
)
返回Field对象中给定字段数的字段名称
(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
从RecordSet对象返回ADO Field对象
(defun DbRsFields (rsObject)
(vlax-Get-Property rsObject "Fields")
)
返回给定Field对象的字段数量
(defun DbRsFieldCount (fObject)
(vlax-Get-Property fObject "Count")
)
获取Field对象的字段名(项)
(defun DbRsFieldItem (fObject fNumber)
(vlax-Get-Property fObject "Item" fNumber)
)
返回RecordSet对象的RowSet对象
(defun DbRsGetRows (rsObject)
(vlax-Invoke-Method rsObject "GetRows" adok-adGetRowsRest)
)
应用一个ADO光标类型到给定的RecordSet对象
(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(锁定)类型到给定的RecordSet对象
(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对象
(defun DbConnection ()
(vlax-Create-Object "ADODB.Connection")
)
创建并返回ADO RecordSet对象
(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 message"
(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
;; 添加当前出错列表到返回值中
(setq ReturnList (cons (reverse ErrorList) ReturnList))
); end while
;; 将返回值设置为正确的顺序
(reverse ReturnList)
); defun
显示由ErrorProcessor函数生成的出错列表的函数。该函数与ErrorProcessor函数分开是
为了ErrorProcessor函数可以在DCL对话框显示时被调用，然后ErrorPrinter可以在对话
框结束后被调用。
(defun ErrorPrinter (ErrorsList)
(foreach ErrorList ErrorsList
(prompt "\n")
(foreach ErrorItem ErrorList
(prompt (strcat (car ErrorItem) "\t\t" (cdr ErrorItem) "\n") )
)
)
(prin1)
)
以下为使用ADO的完整例子：
;;;******************************************************************
;;; 从Access数据库文件(dbFile)的表(tblName)中清理掉列(colName)值为给定的
;;; (value)值的表记录
;;;******************************************************************
(defun DbTableDump
(dbFile tblName colName value / SQLStatement ConnectString)
(setq ConnectString (DbConnect_MSAccess1 dbFile)
SQLStatement (DbSQLCommand tblName colName value)
); setq
(DbQuery ConnectString SQLStatement)
); defun
;;;******************************************************************
;;;ADO 示例程序
;;;******************************************************************
;;; Connects 使用了公用变量ConnectString所指定的连接字符串，而SQL语句为公用
;;; 变量SQLStatement。
;;;
;;; 返回值:
;;;
;;; 如果出现任何错误，则返回NIL。
;;;
;;; 如果SQL语句为"select ..."语句则可返回行、返回一个列表的列表。第一个子列表
;;; 为列名称的列表。如果返回值中包含有行数据，则随后的子列表包含了与第一子列表中
;;; 列名称顺序相同的子列表。
;;;
;;; 如果SQL语句为"delete ..."、"update ..."或"insert ..."则不能返回任何行，
;;; 它将返回T。作者想让它返回所操作的行号，但到目前为止还找不到方法。
;;;******************************************************************
(defun DbQuery
(ConnectString SQLStatement
/ ConnectionObject RecordSetObject FieldsObject FieldNumber
FieldCount FieldList RecordsAffected TempObject ReturnValue
)
;; 创建ADO连接对象
(setq ConnectionObject (DbConnection))
;; 试图打开连接，如果出错 ...
(if (vl-Catch-All-Error-p
(setq TempObject
(vl-Catch-All-Apply
'vlax-Invoke-Method
;; 如果在ConnectString中已经包含了"admin"用户ID和""密码，则这
;; 两个参数可以不需要。
(list
ConnectionObject
"Open"
ConnectString
"admin" ""
adok-adConnectUnspecified
)
); vl-Catch-All-Apply
); setq
); vl-Catch-All-Error-p
;; 则显示出错信息
(ErrorPrinter (ErrorProcessor TempObject ConnectionObject))
;; 打开连接开始处理 ...
(progn
;; 创建ADO Recordset并设置光标和锁定类型
(setq RecordSetObject (DbRecordSet))
(DbRsCursorType RecordSetObject "keyset")
(DbRsLockType RecordSetObject "optimistic")
;; 打开recordset如果出错 ...
(if (vl-Catch-All-Error-p
(setq TempObject
(vl-Catch-All-Apply
'vlax-Invoke-Method
(list RecordSetObject "Open" SQLStatement
ConnectionObject nil nil adok-adCmdText
)
)
)
)
;; 则显示出错信息
(progn
(ErrorPrinter (ErrorProcessor TempObject ConnectionObject))
)
;; 没有出错。如果recordset被关闭 ...
(if (DbRsIsClosed RecordSetObject)
;; 则SQL语句为"delete ..."或"insert ..."或"update ..."，
;; 因为它没返回任何行。这里最好能返回操作过的行号，但作者还不知道
;; 怎样写。现在只有把返回值设为T来表示已经处理了。
(progn
(setq ReturnValue T)
;; 同时关闭recordset，这时已完成。
(MxRelease RecordSetObject)
)
;; recordset打开，SQL 语句为"select ..."。
(progn
;; 获取Fields集合，它包含选定列的名称和属性。
(setq FieldsObject (DbRsFields RecordSetObject) ;; 将字段作为对象
FieldCount (DbRsFieldCount FieldsObject) ;; 取得列的数量
FieldList(DbGetFields FieldsObject FieldCount);; 取得列表中所有列的名称
ReturnValue (list (reverse FieldList))
); setq
;; 如果找到任何行 ...
(if (< 0 (DbRsCount RecordSetObject))
;; 我们来处理最棘手的问题!创建最后结果的列表 ...
(setq
ReturnValue
;; 添加行列表到字段列表中。
(append (list (reverse FieldList))
;; 使用了Douglas Wilson一流的列表转换代码
;; 来创建行列表，因为GetRows返回的项为列顺序
(apply 'mapcar
(cons
'list
;; 设置转换变体列表的列表到AutoLISP标准
;; 的项目列表的列表。
(mapcar
'(lambda (InputList)
(mapcar '(lambda (Item)
(DBL_variant-value Item)
)
InputList
)
)
;; 取得行，将其从变体转换安全数组再到列表
(setq t2 (vlax-SafeArray->list
(vlax-Variant-Value
(DbRsGetRows RecordSetObject)
)
)
); setq
); mapcar
); cons
); apply
); append
); setq
); endif
;; 关闭recordset
(DbCloseRecordset RecordSetObject)
); progn
); endif
); endif
;; 关闭connection
(DbCloseConnection ConnectionObject)
); progn
); endif
;; 返回值
ReturnValue
); defun 谢谢你了，不过这些资料我都已经有了，我过想找点其它的资料 。
页:
[1]