可以使用tcom来 访问 ado，下面是script.net中封装的一个 访问 ado的类，在script.net中可以找到这个类的代码。( http://www.blueantstudio.net ) ################################################################# # tcldb. tcl # author : blueant # ve
可以使用tcom来访问ado，下面是script.net中封装的一个访问ado的类，在script.net中可以找到这个类的代码。(http://www.blueantstudio.net)
#################################################################
# tcldb.tcl
# author     : blueant
# version    : 1.0
# date       : 2007-6-27
# description: tcl database
#################################################################
package provide tcldb 1.0
package require tcom
package require itcl
::itcl::class tadodb {
# 数据库字段类型定义
public common dbtype_empty 0
public common dbtype_null 1
public common dbtype_i2 2
public common dbtype_i4 3
public common dbtype_r4 4
public common dbtype_r8 5
public common dbtype_cy 6
public common dbtype_date 7
public common dbtype_bstr 8
public common dbtype_idispatch 9
public common dbtype_error 10
public common dbtype_bool 11
public common dbtype_variant 12
public common dbtype_iunknown 13
public common dbtype_decimal 14
public common dbtype_ui1 17
public common dbtype_i1 16
public common dbtype_ui2 18
public common dbtype_ui4 19
public common dbtype_i8 20
public common dbtype_ui8 21
public common dbtype_guid 72
public common dbtype_filetime 64
public common dbtype_bytes 128
public common dbtype_str 129
public common dbtype_wstr 130
public common dbtype_numeric 131
public common dbtype_udt 132
public common dbtype_dbdate 133
public common dbtype_dbtime 134
public common dbtype_dbtimestamp 135
# 内部变量定义
protected variable m_cnstr ;# 数据库连接字符串
protected variable m_cn ;# connection对象句柄
protected variable m_rs ;# recordset对象句柄
# 数据集的游标类型3=adopenstatic
protected variable m_cursortype 3
# 数据集的锁定类型1=adlockreadonly
protected variable m_locktype 1
constructor {} {
# 创建ado对象
set ret [catch {set m_cn [::tcom::ref createobject adodb.connection]} msg]
if {$ret} {
error ado连接创建失败,原因:$msg
}
set ret2 [catch {set m_rs [::tcom::ref createobject adodb.recordset]} msg]
if {$ret} {
error ado纪录集创建失败,原因:$msg
}
}
destructor {
close
catch {unset m_cn m_rs}
}
public method getconnectionstring {} {return $m_cnstr} ;# 获取连接字符串
public method open {{cnstr }} ;# 打开数据库连接
public method openmdb {mdbpath} ;# 打开mdb数据库
public method close {} ;# 关闭数据库连接
public method execsql {sqlstr} ;# 执行sql语句,有数据则返回数据列表
public method querytables {{type table}};# 获取table列表
public method querycolumn {tablename {detail }};# 查询表的列名
public method createtable {tablename fields}; # 创建表
}
#-------------------------------------------------------------
#  open database
#  if cnstr is empty, then prompt user to select a database
#-------------------------------------------------------------
::itcl::body tadodb::open {{cnstr }} {
# 关闭连接
close
# 建立连接
if {$cnstr == } {
set ret [catch {set dl [::tcom::ref createobject datalinks]} msg]
if {$ret} {
error ado datalinks对象创建失败,原因:$msg
}
set ret [catch {
set conn [$dl promptnew]
set cnstr [$conn connectionstring]
unset conn
unset dl
} msg]
if {$ret} {
#error 获取连接字符串失败,原因:$msg!
set m_cnstr
return
}
}
set ret [catch {$m_cn open $cnstr} msg]
if {$ret} {
error $msg/n打开数据库连接失败,请检查连接字符串!/n$cnstr
}
# 保存连接字符串
set m_cnstr $cnstr
#pwait 10
return
}
#-------------------------------------------------------------
#  open access database
#-------------------------------------------------------------
::itcl::body tadodb::openmdb {mdbpath} {
open provider=microsoft.jet.oledb.4.0;data source=$mdbpath
return
}
#-------------------------------------------------------------
#  close database
#-------------------------------------------------------------
::itcl::body tadodb::close {} {
# 关闭连接
catch {$m_rs close}
catch {$m_cn close}
#pwait 10
return
}
#-------------------------------------------------------------
#  exec sql
#  if search a recordset, then return recordset data
#-------------------------------------------------------------
::itcl::body tadodb::execsql {sqlstr} {
set m_rowcount 0
# 关闭recordset
catch {$m_rs close}
# 执行查询
set ret [catch {$m_rs open $sqlstr $m_cn $m_cursortype $m_locktype} msg]
if {$ret} {
error $msg/n执行sql语句失败:/n$sqlstr
}
# 检查sql语句是否返回了数据
catch {set m_rowcount [$m_rs recordcount]}
if {$m_rowcount catch {$m_rs close}
return
}
set flds [$m_rs fields]
set m_colcount [$flds count]
set m_data {}
# 数据
catch {
for {set j 1} {$j set line {}
for {set i 0} {$i lappend line [string trimright [$m_rs collect $i]]
}
lappend m_data $line
$m_rs movenext
}
}
# 关闭recordset
catch {$m_rs close}
# 创建并返回数据列表
return $m_data
}
#-------------------------------------------------------------
#  query all tables
#  default is query all table, return table name
#  if type is null, then return list of table name and type
#-------------------------------------------------------------
::itcl::body tadodb::querytables {{type table}} {
# schemaenum 20=adschematables
if {[catch {set srs [$m_cn openschema 20]} msg]} {
error $msg
}
set data {}
while {[$srs eof] == 0} {
if {($type != ) && ($type != -all)} {
if {[$srs collect table_type] == $type} {
lappend data [$srs collect table_name]
}
} else {
lappend data [list [$srs collect table_name] [$srs collect table_type]]
}
$srs movenext
}
catch {$srs close}
return $data
}
#-------------------------------------------------------------
#  query one table＇s all column information
#  if follow -detail parameter, then return column detail info
#  detail is column＇s: name, hasdefault, default, nullable,
#                      data type, max length
#-------------------------------------------------------------
::itcl::body tadodb::querycolumn {tablename {detail }} {
# schemaenum 4=adschemacolumns
if {[catch {set srs [$m_cn openschema 4]} msg]} {
error $msg
}
set data {}
while {[$srs eof] == 0} {
if {[$srs collect table_name] == $tablename} {
if {$detail == -detail} {
lappend data [list  [$srs collect column_name] /
[$srs collect column_hasdefault] /
[$srs collect column_default] /
[$srs collect is_nullable] /
[$srs collect data_type] /
[$srs collect character_maximum_length] /
]
} else {
lappend data [$srs collect column_name]
}
}
$srs movenext
}
catch {$srs close}
return $data
}
#-------------------------------------------------------------
#  create new table
#  field parameter is a list of field, every field is a list
#  of field name, type, size, default value, not null, auto
#  increment, primary key or index or unique
#-------------------------------------------------------------
::itcl::body tadodb::createtable {tablename fields} {
set lstable [querytables]
if {[lsearch $lstable $tablename] != -1} {
error 数据库中已经存在名为 $tablename 的对象。
}
set sql create table $tablename/(
set field_count 0
foreach field $fields {
set field_name [lindex $field 0]
if {$field_name == } {
continue;
}
set field_type [lindex $field 1]
set field_size [lindex $field 2]
set field_default [lindex $field 3]
set field_notnull
if {[lsearch [lrange $field 4 end] notnull] != -1} {
set field_notnull notnull
}
set field_extend
if {[lsearch [lrange $field 4 end] auto_increment] != -1} {
set field_extend auto_increment
}
set field_key
if {[lsearch [lrange $field 4 end] primary] != -1} {
set field_key primary
} elseif {[lsearch [lrange $field 4 end] index] != -1} {
set field_key index
} elseif {[lsearch [lrange $field 4 end] unique] != -1} {
set field_key unique
}
if {$field_count > 0} {
set sql $sql ,
}
set sql $sql $field_name $field_type
if {($field_size != ) && ($field_size != 0)} {
set sql $sql/($field_size/)
}
if {$field_notnull != } {
set sql $sql not null
}
if {$field_default != } {
if {[lsearch $field_type {text longtext varchar}] != -1} {
set sql $sql default ＇$field_default＇
} else {
set sql $sql default $field_default
}
}
if {$field_extend == auto_increment } {
set sql $sql autonumber
}
switch $field_key {
primary { set sql $sql primary key }
index {}
unique {}
}
incr field_count
}
set sql $sql /)
execsql $sql
}