求助lisp access数据库写入输出数据!!

nameld001

急求!!以下是抄自板主meflying的程序,请问如何修改可写进数据,比如我想写个横坐标进去,

我的邮箱wwokwell8866@sina.com

谢谢帮忙了

(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 pspoint")
  (vlax-invoke-method DBConnection "open" (DbConnect_MSAccess1 "e:\\AAA.mdb") "admin" "" adok-adConnectUnspecified)
  (vlax-invoke-method RSObject "open" SqlString DBConnection nil nil adok-adcmdtext)
  (search rsobject)
  (DbCloseRecordset rsobject)
  (DbCloseConnection dbconnection)
  (princ)
)

　　　　　　　　抄自meflying@mjtd.com
　　　　　　　　　　2004-10-10

ttmax501

;引用数据库函数
; ---------------------------------------------------------
; InitADO: 初始化ADO控件
; 局部变量:
;     DllFile   ADO动态链接库文件
(defun InitADO ( / DllFile)
  (setq DllFile (strcat (getenv "systemdrive") "\\Program Files\\Common Files\\System\\Ado\\msado15.dll"))
  (if (findfile DllFile)
    (vlax-Import-Type-Library
      :tlb-filename DllFile
      :methods-prefix "adom-"
      :properties-prefix "adop-"
      :constants-prefix "adok-"
    )
    (alert (strcat "找不到文件:\n\n" DllFile))
  )
)
; ---------------------------------------------------------
; CreateConnection: 创建数据库连接对象
; 返回值:
;     已创建的数据库连接对象
(defun CreateConnection ()
  (vlax-Create-Object "ADODB.Connection")
)
; ---------------------------------------------------------
; CreateRecordSet: 创建记录集对象
; 返回值:
;     已创建的记录集对象
(defun CreateRecordSet ()
  (vlax-Create-Object "ADODB.RecordSet")
)
; ---------------------------------------------------------
; ConnectMDB: 根据MDB文件名生成连接字符串
; 参数:
;     MDBFile  Access数据库文件名
; 返回值:
;     生成的连接字符串
(defun ConnectMDB (MDBFile)
  (strcat
    "Provider=MSDASQL;"
    "Driver={Microsoft Access Driver (*.mdb)};"
    "DBQ=" MDBFile
  )
)
; ---------------------------------------------------------
; SQLSelect: 由字段名，表名，查找条件生面SQL的Select语句
; 参数:
;     FieldName  字段名
;     TablaName  表名
;     Condition  条件
; 局部变量:
;     CmdString  用于临时存放生成的Select语句
; 返回值:
;     生成的Select语句字符串
(defun SQLSelect (FieldName TableName Condition / CmdString)
  (setq CmdString (strcat "SELECT " FieldName " FROM " TableName))
  (if (> (strlen Condition) 0)
    (setq CmdString (strcat CmdString " WHERE " Condition))
  )
  CmdString
)
; ---------------------------------------------------------
; MxRelease: 释放已创建的对象
; 参数:
;     xObject    待释放的对象
(defun MxRelease (xObject)
  (if (not (vlax-object-released-p xObject))
    (vlax-Release-Object xObject)
  )
)
; ---------------------------------------------------------
; MxRelease: 关闭数据库连接
; 参数:
;     ConnectObject    待关闭的数据库连接
(defun DisConnect (ConnectObject)
  (vlax-Invoke-Method ConnectObject "Close")
  (MxRelease ConnectObject)
)
; ---------------------------------------------------------
; CloseRecordSet: 关闭记录集
; 参数:
;     rsObject    待关闭的记录集对象
(defun CloseRecordSet (rsObject)
  (vlax-Invoke-Method rsObject "Close")
  (MxRelease rsObject)
)
; ---------------------------------------------------------
; IsRsClosed: 记录集是否关闭
; 参数:
;     rsObject    记录集对象
; 返回值:
;     记录集已关闭，返回T，否则返回nil
(defun IsRsClosed (rsObject)
  (= adok-adStateClosed (vlax-Get-Property rsObject "State"))
)
; ---------------------------------------------------------
; RsGetRows: 取得记录集的长度
; 参数:
;     rsObject    记录集对象
; 返回值:
;     记录集长度
(defun RsGetRows (rsObject)
  (vlax-Invoke-Method rsObject "GetRows" adok-adGetRowsRest)
)
; ---------------------------------------------------------
; ErrorProcessor: 数据库错误处理
; 参数:
;     VLErrorObject    错误对象
;     ConnectionObject 数据库连接对象
; 返回值:
;     错误消息
(defun ErrorProcessor (VLErrorObject ConnectionObject / ErrorsObject ErrorObject ErrorCount ErrorNumber ErrorList ErrorValue)
  (setq
    ReturnList (list (list (cons "Visual LISP message" (vl-Catch-All-Error-Message VLErrorObject))))
    ErrorObject (vlax-Create-Object "ADODB.Error")
    ErrorsObject (vlax-Get-Property ConnectionObject "Errors")
    ErrorCount (vlax-Get-Property ErrorsObject "Count")
    ErrorNumber -1
  )
  (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))
    )
    (setq ReturnList (cons (reverse ErrorList) ReturnList))
  )
  (reverse ReturnList)
)
; ---------------------------------------------------------
; ErrorPrinter: 输出错误消息
; 参数:
;     ErrorsList    错误消息
(defun ErrorPrinter (ErrorsList)
  (foreach ErrorList ErrorsList
    (prompt "\n")
    (foreach ErrorItem ErrorList
      (prompt (strcat (car ErrorItem) "\t\t" (cdr ErrorItem) "\n"))
    )
  )
  (prin1)
)
; ---------------------------------------------------------
; Query: 执行SQL语句
; 参数:
;     ConnectionObject    数据库连接对象
;     SQLStatement        SQL语句
; 局部变量:
;     RecordSetObject     记录集对象
;     TempObject          错误对象
;     ReturnValue         临时保存返回值
; 返回值:
;     Select语句返回查得的记录表
;     其它语句执行成功后返回T
(defun Query (ConnectionObject SQLStatement / RecordSetObject TempObject ReturnValue)
  (setq RecordSetObject (CreateRecordSet))
  (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)))
    (if (IsRsClosed RecordSetObject)
      (progn
        (setq ReturnValue T)
        (MxRelease RecordSetObject)
      )
      (progn
        (setq ReturnValue (vlax-SafeArray->list (vlax-Variant-Value (RsGetRows RecordSetObject))))
        (setq ReturnValue
          (mapcar
           '(lambda (x)
              (mapcar 'vlax-variant-value x)
            )
            ReturnValue
          )
        )
        (CloseRecordSet RecordSetObject)
      )
    )
  )
  ReturnValue
)
; ---------------------------------------------------------
; TransformList: 对表进行行列交换
; 参数:
;     theList      待交换的表
; 局部变量:
;     i            标号1
;     j            标号2
;     Len1         长度1
;     Len2         长度2
;     ReturnValue  临时保存返回值
;     RowValue     保存一行的值
;     Temp         临时变量
; 返回值:
;     已交换行列的记录表
(defun TransformList (theList / i j Len1 Len2 ReturnValue RowValue Temp)
  (setq Len1 (length theList) Len2 (length (car theList)) j 0)
  (repeat Len2
    (setq RowValue nil i 0)
    (repeat Len1
      (setq Temp (nth i theList))
      (setq RowValue (append RowValue (list (nth j Temp))))
      (setq i (1+ i))
    )
    (setq ReturnValue (append ReturnValue (list RowValue)))
    (setq j (1+ j))
  )
  ReturnValue
)
; 数据库处理函数到此结束

nameld001

谢谢了,我试试看

nameld001

请问上楼的大侠,这两句是什么意思"adodb.connection"与   "adodb.recordset"

"admin" "" adok-adConnectUnspecified那里讲有这些有关内容啊   

(setq DBConnection (vlax-create-object "adodb.connection"))        ;创建并返回ADO Connection对象
  (setq RSObject (vlax-create-object "adodb.recordset"))        ;创建并返回

nameld001

大家再帮下上面大虾我还是不知怎样写进数据下面我给个库给大家帮看看，

比如在D:\11.mdb的字段“号码”接着写进去“45678”这个数字为例请大家帮帮忙了急！！！！！

xxsheng

nameld001发表于2006-5-31 1:15:00 大家再帮下上面大虾我还是不知怎样写进数据下面我给个库给大家帮看看， 比如在D:\11.mdb的字段“号码”接着写进去“45678”这个数字为例请大...

(setq CmdString (strcat CmdString " WHERE " Condition))

这一句改为(setq CmdString(strcat "INSERT INTO " "标准设备尺寸" filedslist "VALUES" vlist));其中"设备标准尺寸"为你的11.mdb的要插入的表的名称,filedslist形式如" (型号, 品牌) "注意,括号的前后有空格,也就是你要插入的值所在字段名,vlist形式如" ('JX1880', '捷信') "注意括号的前后空格.运行的结果就是插入了一行,字段型号值为JX1880',品牌为捷信的行了.如果是要更新,语句为

(setq CmdString(strcat "UPDATE " "标准设备尺寸" " SET " editvalue " WHERE " searchvalue));估计也没有几个人用的到,,,,哈哈~

nameld001

没有主函数,我没有办法调试,可不可以帮我写个主函数就用(c:test)主函数改写一下行吗,我也对这个还比较陌生,所以请你们体谅了,

小弟在此先谢谢你了

nameld001

大侠们，帮帮忙啊，拜托了

nameld001

大侠们都没看到我的贴子吗，帮帮忙啊

jxphklibin

很好，读取数据，写入数据，更新数据都可以了！！！！