[求助]autolisp如何调用数据库？

superxzg 发表于 2007-2-5 16:37:00

有一组数据，举例如下： 序号形状半径 1    圆   10 2    圆   20 ... 想要保存成文件并随时供lisp调用，而且其中数据需要经常变动如何实现啊？是不是必须调用Access啊，如何调用？ 请大家帮忙，多谢！

superxzg 发表于 2007-2-5 20:30:00

听说可以用文本文件作为lisp的数据库，不知是否有此功能，如何实现？

hustrys 发表于 2007-2-13 22:25:00

完全可以，试试下面程序，修改一下就能运行   ;;;;txt2list 将读入行转化为数列 (defun Txt2list (rc / p sp len sl la temp str data)   (setq p   1  sp  1  len 1  sl  (strlen rc)   ;strlen函数:提取字符度   la  (list nil)   )        (setq sl2 (+ 1 sl))   (while (<= p sl2)     (progn       (setq temp (substr rc p 1)) ;substr函数:提取字符串中一子字符串       ;(princ "\n temp=") (princ temp)       (if (or (= temp "") (= temp " "))  (progn    (setq str  (substr rc sp len)   sp   (1+ p)   len  0    )    ;(princ "     str=") (princ str)    (if (or(/= str"")(= str " "))           (progn      (setq  data (atof str))  ;atof函数:将字符串转化为数           (setq  la (append la (list data))) ;append函数:将任意数量的的表组合成一个表      ;(princ "  data=") (princ data)          ) ;end progn for if     ) ;end  if            )  ;end progn for if  (setq len (1+ len))       )  ; end progn for while       (setq p (1+ p))     ) ;end while   )   (setq la (vl-remove nil la))  ;vl-remove函数:从表中删除元素 ) ;;;;****************************** ;;读取数据      (defun readdata1(filename / fp databt dt1)   ;filename为要打开的文件名。      (if (setq fp(open (Findfile filename) "r"))           (progn                (setq databt'())          (setq dt1(read-line fp))          (while dt1                          (setq databt (append databt (list dt1)))             (setq dt1(read-line fp))               ) ;end while                (close fp)                   (setq listname (strcat name"_data"))    (setq Data_list databt)        );end progn       (princ(strcat"\n failed Open file:"filename "!!!\n "))  ) ;end if         )  ;;读取数据束 ;分解数据   ( defun getdata()    (setq dataline(nth (atoi(get_tile listname)) Data_list))      (setq  dt(Txt2list dataline ) )     (if (<= draw_index 3)       (progn       (setq DN(nth 0 dt))          (setq D(nth 1 dt))  ;(IF (= draw_index 1)          ;(setq F(nth 3 dt))   (setq F(nth 2 dt))   ; )          ;(princ "\n  dataline=")          ;(princ dt)          ;(princ "\n  DN=") (princ DN)(princ "  D=") (princ D)         ; (princ "  F=") (princ F)(princ " strleng=") (princ (length dt))        )  ;end progn       )   ;end if     (if (and (> draw_index 3)(< draw_index 10))       (progn       (setq DN(nth 0 dt))          (setq C(nth 1 dt))          (setq D1(nth 2 dt))   (setq D2(nth 3 dt))   (setq M(nth 4 dt))          ;(princ "\n  dataline=")         ; (princ dt)          (princ "\n  DN=") (princ DN)(princ "  c=") (princ c)(princ "  D1=") (princ D1)          (princ "  D2=") (princ D2)(princ "  M=") (princ M)        )  ;end progn       )   ;end if      (if (or(= draw_index 10)(= draw_index 11))       (progn       (setq DN(nth 0 dt))                  (setq D1(nth 1 dt))   (setq D2(nth 2 dt))   (setq L(nth 3 dt))        )  ;end progn       )   ;end if         (setq IS_getdata 1)        (princ )      ;(princ "  Is_getdata   get=")(princ Is_getdata)   )

NetBee 发表于 2007-2-13 23:26:00

lisp与access<a href="http://www.mjtd.com/Blog/user1/41/archives/2005/26.asp">http://www.mjtd.com/Blog/user1/41/archives/2005/26.asp</a>

NetBee 发表于 2007-2-13 23:31:00

本帖最后由作者于 2007-2-13 23:34:46 编辑

老大的：
[ 作者：郑立楷 | 来源：mjtd | 时间：2006-1-21 12:28:22 ]
在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
(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

mccad 发表于 2007-2-14 08:41:00

呵呵，这个程序不是我写的，而是我前翻译过来的。应该说这个程序不太好使用，因为使用的知识点太多了，而在普通的LISP应用中，并不需要这么强大(看不懂的强大)。我现在的观点了，LISP在处理表LIST的能力是很强的，所以，我们就用SQL提供的GetRows方法，直接把得到的数据转成数组后再转成LIST表，这样交给LISP处理的话，也就太简单了。而对数据库的更新，直接使用UPDATE语句来完成，新增记录可以使用INSERT语句来完成。基本上，在LISP中我们并不需要让数据库一直在打开的状态下移动记录行位置做判断，没有必要。而应该是这样，把数据读出来，处理完后再把数据库更新回去。而在楼主的这项应用中，除了用数据库来解决外，直接文本文件来处理也方便，要不然用XML格式文件来处理也是非常方便的。

cherio8888 发表于 2012-1-13 11:16:06

调试的时候，(vlax-Put-Property rsObject "CursorType" adok-adOpenKeyset)出错，“错误: ActiveX 服务器返回错误: 无效的参数数目”，找不到原因，请高手帮忙。

smartstar 发表于 2012-5-4 21:08:41

做个记号，以后来学习。

页: [1]

明经CAD社区's Archiver

[求助]autolisp如何调用数据库？