****老调重弹，VLISP链接数据库，并赋值！（想到办法了，已解决）****

aicr317

如下：

(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
)
)

;从内存中释放VLA对象
(defun MxRelease (xObject)
vlax-object-released-p
(if (not (vlax-object-released-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 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)
    )
)
)

(defun Search(RSObject / lst FieldsObject FieldCount FieldList ReturnValue)
(defun getlst    (var)
    (setq lst nil)
    (setq n (length var) i 0)
    (while (< i n)
      (setq lst (append lst (list (vlax-variant-value (nth i var)))))
      (setq i (1+ i))
    )
    lst
)
(setq    FieldsObject (DbRsFields RSObject)        ;; 将字段作为对象
    FieldCount   (DbRsFieldCount FieldsObject)        ;; 取得列的数量
    FieldList    (DbGetFields FieldsObject FieldCount)    ;; 取得列表中所有列的名称
    ReturnValue (list (reverse FieldList)))        ; setq
(setq    lst (vlax-safearray->list (vlax-variant-value (dbrsgetrows rsobject))))
(setq lst (mapcar 'getlst lst))
(setq lst (mapcar '(lambda(var1 var2) (append (list var1) (list var2))) (car returnvalue) lst))
(print lst)
)

;A sample...
(defun c:test (/ getlst dbconnection rsobject SqlString)
(DbInitADO)                ;初始化
(setq DBConnection (vlax-create-object "adodb.connection"))        ;创建并返回ADO Connection对象
(setq RSObject (vlax-create-object "adodb.recordset"))        ;创建并返回ADO RecordSet对象

(setq SqlString "select 点号  from aaa")   ;;;想到办法了，SELECT可以选多个，只要逗号分隔就OK了！！！
  

;;;如果还想读另一个字段或者更多字段下的列表该如何写？？？

;;;如有另一字段为“标高”

;;;能否(setq SqlStrings "select 标高  from aaa")  ；；；那么如何不重复定义(search rsobject)

(vlax-invoke-method DBConnection "open" (DbConnect_MSAccess1 "e:\\AAA.mdb") "admin" "" adok-adConnectUnspecified)

(vlax-invoke-method RSObject "open" SqlString DBConnection nil nil adok-adcmdtext)
(setq DNTABLE (search rsobject))  ;;;返回点号这个字段下的列表
(DbCloseRecordset rsobject)
(DbCloseConnection dbconnection)
(princ))

aicr317

在线等，急需！

liu_kunlun

试一下：

(vlax-invoke-method RSObject "open" SqlString DBConnection nil nil adok-adcmdtext)
(setq out (search rsobject))
(DbCloseRecordset rsobject)
(DbCloseConnection dbconnection)
(princ))

aicr317

最后一个问题

命令: (LOAD "d:/jiangmj/桌面/sql.lsp")
(("点号" ("0000" "1111" "2222" "3333" "4444")))

加载SQL.LSP后，自动在命令行显示这串（红色部分），如何让他不显示，我用了上述(setq out (search rsobject)) 的方法，还是会显示！

liu_kunlun

(defun Search(RSObject / lst FieldsObject FieldCount FieldList ReturnValue)
(defun getlst    (var)
    (setq lst nil)
    (setq n (length var) i 0)
    (while (< i n)
      (setq lst (append lst (list (vlax-variant-value (nth i var)))))
      (setq i (1+ i))
    )
    lst
)
(setq    FieldsObject (DbRsFields RSObject)        ;; 将字段作为对象
    FieldCount   (DbRsFieldCount FieldsObject)        ;; 取得列的数量
    FieldList    (DbGetFields FieldsObject FieldCount)    ;; 取得列表中所有列的名称
    ReturnValue (list (reverse FieldList)))        ; setq
(setq    lst (vlax-safearray->list (vlax-variant-value (dbrsgetrows rsobject))))
(setq lst (mapcar 'getlst lst))
(setq lst (mapcar '(lambda(var1 var2) (append (list var1) (list var2))) (car returnvalue) lst))
(print lst) ;;去掉此句
)

aicr317

谢谢！等弄完这个，好好找本书学习！

aicr317

新问题又来了

ok0628

学习下 谢谢了