lisp语句操作ACCESS数据库的例子

http://www.vllbv.com/xianshineirong.asp?idhao=79

;(setq con (tls-ado-opencon (strcat (vla-get-path (vlax-get-acad-object)) "/tlscad/bin/house.mdb")))
;(tls-ado-runtrans con "insert into houseinfo values(´1´,´2´,´0001´,67,´zh´,23,´lzh´,4,´´)")
;(setq rs (tls-ado-openrs con "select * from houseinfo order by place,name,hid"))
;(tls-ado-fields->list rs)
;(tls-ado-movefirst rs)
;(tls-ado-movenext rs)
;(vla-close rs)
;(vla-close con)

(defun tls-ado-opencon(filename / con connectionstring)
(setq con (vlax-create-object "ADODB.Connection"))
(setq
connectionstring
(strcat
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
filename
";Persist Security Info=False"
)
)
(vla-open con connectionstring "" "" -1)
con
)

(defun tls-ado-openrs(con sql / rs)
(setq rs (vlax-create-object "ADODB.Recordset"))
(vlax-put-property rs "CursorLocation" 3)
(vlax-put-property rs "CursorType" 2)
(vla-open rs sql con nil nil nil)
rs
)
(defun tls-ado-getvalue(rs name)
(vlax-variant-value
(vlax-get-property
(vlax-get-property
(vlax-get-property rs "Fields")
"item"
name
)
"value"
)
)
)
(defun tls-ado-getname(rs name)
(vlax-get-property
(vlax-get-property
(vlax-get-property rs "Fields")
"item"
name
)
"name"
)
)
(defun tls-ado-fields->list(rs / count pcount lst curval)
(setq count (vlax-get-property (vlax-get-property rs "Fields") "Count"))
(setq pcount count)
(repeat
count
(setq curval (tls-ado-getvalue rs (setq pcount (1- pcount))))
(setq lst (cons curval lst))
)
)
(defun tls-ado-fieldnames->list(rs / count pcount lst curval)
(setq count (vlax-get-property (vlax-get-property rs "Fields") "Count"))
(setq pcount count)
(repeat
count
(setq curval (tls-ado-getname rs (setq pcount (1- pcount))))
(setq lst (cons curval lst))
)
)
(defun tls-ado-movefirst(rs)
(vlax-invoke-method rs "movefirst")
(tls-ado-fields->list rs)
)
(defun tls-ado-movelast(rs)
(vlax-invoke-method rs "movelast")
(tls-ado-fields->list rs)
)
(defun tls-ado-movenext(rs)
(vlax-invoke-method rs "movenext")
(if (= (vlax-get-property rs "eof") :vlax-false)
(tls-ado-fields->list rs)
nil
)
)
(defun tls-ado-moveprevious(rs)
(vlax-invoke-method rs "moveprevious")
(if (= (vlax-get-property rs "bof") :vlax-false)
(tls-ado-fields->list rs)
nil
)
)
(defun tls-ado-runtrans(con sql / err)
(vlax-invoke-method con "BeginTrans")
(setq err
(vl-catch-all-apply ´vlax-invoke-method
(list con "Execute" sql nil nil)
)
)
(vlax-invoke-method con "CommitTrans")
(not (vl-catch-all-error-p err))
)
(defun c:fado( / objname obj attribs attrib sql con rs lst str i val namelst count)
(setq objname "" sql "" str "")
(while (not (= objname "AcDbBlockReference"))
(setq obj (vlax-ename->vla-object (car (entsel "\n选择房屋:"))))
(setq objname (vla-get-objectname obj))
)
(setq attribs (vlax-safearray->list (vlax-variant-value (vla-getattributes obj))))
(foreach attrib attribs
(setq sql (strcat sql (vla-get-tagstring attrib) "=´" (vla-get-textstring attrib) "´ and "))
)
(setq sql
(strcat
"select * from houseinfo where "
(substr sql 1 (- (strlen sql) 5))
" order by place,name,hid"
)
)
(setq con (tls-ado-opencon (findfile "house.mdb"))
rs (tls-ado-openrs con sql)
lst (tls-ado-fields->list rs)
)
(vla-close rs)
(vla-close con)
(setq namelst ´("地点:" "名称:" "房号:" "面积:" "类别:" "价格:" "房主:" "人口:" "备注:"))
(setq count 0)
(repeat 9
(setq i (nth count lst))
(if (not i) (setq i ""))
(setq val (vl-catch-all-apply ´rtos (list i))
val (if (vl-catch-all-error-p val) i val)
str (strcat str "\n" (nth count namelst) val)
count (1+ count)
)
)
(alert str)
(princ)
)