tcl连接mysql_Tcl访问SQLServer等数据库的方法

可以使用tcom来访问ADO，下面是Script.NET中封装的一个访问ADO的类，在Script.NET中可以找到这个类的代码。

[@more@]

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 < 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

}

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/459749/viewspace-1057381/，如需转载，请注明出处，否则将追究法律责任。