Tcl访问SQLServer等数据库的方法

可以使用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 create object "ADODB.Connection"]} msg]
if {$ret} {
error "ADO连接创建失败,原因:$msg"
}
set ret2 [catch {set m_rs [::tcom::ref create object "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 create object "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 < 1} {
catch {$m_rs Close}
return
}

set flds [$m_rs Fields]
set m_colcount [$flds Count]
set m_data {}

# 数据
catch {
for {set j 1} {$j <= $m_rowcount} {incr j} {
set line {}
for {set i 0} {$i < $m_colcount} {incr 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
}