Tcl訪問SQLServer等數據庫的方法

可以使用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 < 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
}

聲明：本網頁內容旨在傳播知識，若有侵權等問題請及時與本網聯系，我們將在第一時間刪除處理。TEL:177 7030 7066 E-MAIL:11247931@qq.com