;;;access数据库操作函数，全部代码来自于 范建威 。十分感谢。

;;;函数名称:BF-Access-New
;;;函数说明:新建数据库
;;;参    数:files:数据库文件存储路径
;;;返 回 值:成功返回t，失败nil
;;;示    例:(BF-Access-New "C:\\AA.MDB")
(defun BF-Access-New(files)
	(vl-load-com)
	;;数据库存在是不能新建的
	(if (findfile files)
		(progn
			(prompt "\n数据库名称一存在，无法新建\n")
			nil
		)
		(progn
			(setq accessApp (vlax-get-or-create-object"access.application"))
			(vlax-invoke accessApp 'NewCurrentDatabase files)
			(vlax-invoke accessApp 'CloseCurrentDatabase)
			(vlax-release-object accessApp)
			t
		)
	)
)

;;;函数名称:BF-Access-Open
;;;函数说明:使用Ado访问数据库
;;;参    数:AccessFilename:数据库文件路径
;;;返 回 值:数据库对象
;;;示    例:(BF-Access-Open "C:\\AA.MDB")
(defun BF-Access-Open(AccessFilename / Accessobject accessstring provider)
	(vl-load-com)
	(setq Accessobject (vlax-create-object "Adodb.Connection"))
	;;判断Access使用ACE.OLEDB.12.0还是Jet.OLEDB.4.0
	(setq ExcelObject (vlax-get-or-create-object "Excel.Application" ))
	(setq Application (Vlax-Get ExcelObject	'Application ))
	(setq ProductCode (Vlax-Get Application	'ProductCode ))
	(vlax-release-object ExcelObject)
	(setq num (substr ProductCode 21 1))
	(setq Provider
		(cond
			((= num "1")"Microsoft.ACE.OLEDB.12.0");;64位
			((= num "0")"Microsoft.Jet.OLEDB.4.0" );;32位
			((= num "8")"Microsoft.Jet.OLEDB.4.0" );;32位
		)
	)
	(setq AccessString   (strcat "Provider=" Provider ";Data Source=" AccessFilename));设置数据库连接字符串
	(vlax-invoke-method Accessobject "open" AccessString "" "" -1)
	Accessobject
)

;;;函数名称:BF-Access-Close
;;;函数说明:关闭数据库
;;;参    数:Accessobject:数据库对象
;;;返 回 值:无
;;;示    例:(BF-Access-Close Accessobject)
(defun BF-Access-Close(Accessobject)
	(vla-Close Accessobject)
	(vlax-release-object Accessobject)
	(princ)
)

;;;函数名称:BF-Access-Select
;;;函数说明:数据库运行Sql查询
;;;参    数:Accessobject:数据库对象
;;;参    数:SQL:SQL查询语句字符串
;;;返 回 值:查询的结果表
;;;示    例:(BF-Access-Select access "select * from 点表")
(defun BF-Access-Select(Accessobject SQL / aa lst num rows rset)
	(setq Rset(Vlax-Get-Or-Create-Object "ADODB.Recordset" ))
	(vlax-invoke-method Rset 'open sql Accessobject 3 3 -1)
	(if (/= (vlax-get-property Rset "EOF") :vlax-true)
		(progn
			(Vlax-Invoke-Method Rset 'MoveFirst)
			(setq num (Vlax-Get Rset 'RecordCount))
			(setq lst nil)
			(repeat num
				(setq rows (Vlax-Invoke-Method Rset 'GetRows 1))
				(setq aa
					(subst 
						""
						nil
						(mapcar
							'(lambda (x) (vlax-variant-value (car x)))
							(vlax-safearray->list (vlax-variant-value rows))
						)
					)
				)
				(setq lst (cons aa lst))
			)
		)
	)
	(vlax-invoke-method Rset 'close)
	lst
)

;;;函数名称:BF-Access-Execute
;;;函数说明:运行sql语句，如更新/删除/创建表单
;;;参    数:Accessobject:数据库对象
;;;参    数:sql:sql语句字符串
;;;返 回 值:sql语句执行的结果
;;;示    例:(BF-Access-Execute access "UPDATE 点表 SET 管线种类 = '污水1' WHERE 物探点号 = 'WS1'")
;(BF-Access-Execute access "DELETE FROM 点表 WHERE 物探点号 = 'YS991111'")
;(BF-Access-Execute access "CREATE TABLE Point (PointID varchar(255),Code varchar(255),ExpNum varchar(255),Feature varchar(255),Subsid varchar(255),X varchar(255),Y varchar(255),H varchar(255),TextId varchar(255))")
(defun BF-Access-Execute(Accessobject sql)
	(vlax-invoke-method Accessobject "Execute" sql nil -1)
)

;;;函数名称:BF-Access-Parse
;;;函数说明:将普通列表转换为数据库可识别的sql语句格式的字符串
;;;参    数:lst:列表
;;;返 回 值:sql语句格式的字符串
;;;示    例:(BF-Access-Parse lst)
(defun BF-Access-Parse (lst / bb cc num)
	(setq cc "")
	(foreach aa lst
		(cond
			((= (type aa) 'REAL);;实数
				(setq num (rtos aa 2 3))
			)
			((= (type aa) 'INT);;整数
				(setq num (rtos aa 2 3))
			)
			((= (type aa) 'STR);;整数
				(setq num aa)
			)
		)
		(setq cc (strcat cc "'" num "'" ","))
	)
	(strcat "(" (substr cc 1 (1- (strlen cc))) ")")
)