回望南山
记忆痕迹可以鲜明, 回望往事如数家珍——
posts - 177,  comments - 54,  trackbacks - 0

;;;在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-"
:properties-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  

posted on 2008-03-10 14:37 深藏记忆 阅读(1585) 评论(3)  编辑  收藏 所属分类: Vlisp之韵

FeedBack:
# re: VLISP使用数据库.lsp
2008-03-25 20:40 | 数据库新手
lisp与数据库(不论是ACCESS或是MS SQL)接口都非常繁杂,实际上我们可以换一种思路操作数据库。一、从CAD、LISP到数据库,单纯从作图角度来说,主要是读取数据库中的数据,再转化成图形;二、由于LISP调用函数功能非常强大;三、由于VBA与数据库接口功能非常强。因此我们完全可以按照以下思路连接数据库:1、用LISP语言调用VBA程序连接数据库并生成一个.TXT;2、用LISP读取.TXT文件并成图;3、用LISP语言重新改写这个.TXT文件,使其在外表看不露痕迹。 按上面思路编写程序,其代码不及上述的5分之一  回复  更多评论
  
# re: VLISP使用数据库.lsp
2008-03-25 21:55 | 深藏记忆
@数据库新手 可是“老手”?哈哈

  回复  更多评论
  
# re: VLISP使用数据库.lsp
2010-05-04 20:57 | 起子
正在找这方面的资料,研究一下看看。  回复  更多评论
  

飘过是缘,相识最真

订阅到抓虾
google reader
gougou


点击这里给我发消息


<2010年5月>
2526272829301
2345678
9101112131415
16171819202122
23242526272829
303112345

常用链接

留言簿(5)

随笔分类

随笔档案

文章分类

文章档案

相册

收藏夹

八面来息

天天充电

同行者

积分与排名

  • 积分 - 58602
  • 排名 - 61

最新评论

阅读排行榜

评论排行榜