Methods for accessing databases such as SQLServer through Tcl

You can use tcom to access ADO. The following is a class for accessing ADO encapsulated in Script. NET. The code of this class can be found in Script. NET. (Www.blueantstudio.net) ######################################## ######################### TclDB. tcl # Author: blueant # Ve

You can use tcom to access ADO. The following is a class for accessing ADO encapsulated in Script. NET. The code of this class can be found in Script. NET. Http://www.blueantstudio.net) ######################################## ######################### TclDB. tcl # Author: blueant # Ve

You can use tcomAccessADO, which is encapsulated in Script. NETAccessADO class, you can find the code of this class in 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 {

#DatabaseField Type Definition
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

# Internal variable definition
Protected variable m_cnstr "";#DatabaseConnection string
Protected variable m_cn ""; # Connection object handle
Protected variable m_rs ""; # Recordset object handle

# Dataset cursor Type 3 = adOpenStatic
Protected variable m_CursorType 3
# Dataset lock type 1 = adLockReadOnly
Protected variable m_LockType 1

Constructor {}{
# Create An ADO object
Set ret [catch {set m_cn [: tcom: ref createObject"ADODB. Connection"]} msg]
If {$ ret }{
Error "ADO connection creation failed, cause: $ msg"
}
Set ret2 [catch {set m_rs [: tcom: ref createObject"ADODB. Recordset"]} msg]
If {$ ret }{
Error "An error occurred while creating the ADO record set. Cause: $ msg"
}
}

Destructor {
Close
Catch {unset m_cn m_rs}
}

Public method GetConnectionString {}{ return $ m_cnstr}; # obtain the connection string
Public method Open {cnstr "" }}; # OpenDatabaseConnection
Public method OpenMdb {mdbpath}; # Open MDBDatabase
Public method Close {}; # CloseDatabaseConnection
Public method ExecSql {sqlstr}; # execute an SQL statement. If data exists, the system returns the data list.
Public method QueryTables {type TABLE }}; # obtain the Table list
Public method QueryColumn {tablename {detail "" }}; # query the table column name
Public method CreateTable {tablename fields}; # create a table
}
#-------------------------------------------------------------
# Open Database
# If cnstr is empty, then prompt user to select a database
#-------------------------------------------------------------
: Itcl: body TAdoDb: Open {cnstr ""}}{
# Closing a connection
Close
# Establish a connection
If {$ cnstr = ""}{
Set ret [catch {set dl [: tcom: ref createObject"Datalinks"]} msg]
If {$ ret }{
Error "ADO Datalinks object creation failed, cause: $ msg"
}

Set ret [catch {
Set conn [$ dl PromptNew]
Set cnstr [$ conn ConnectionString]
Unset conn
Unset dl
} Msg]
If {$ ret }{
# Error "failed to get the connection string. Cause: $ msg! "
Set m_cnstr ""
Return
}
}
Set ret [catch {$ m_cn Open $ cnstr} msg]
If {$ ret }{
Error "$ msg/n openDatabaseConnection Failed. Check the connection string! /N $ cnstr"
}

# Saving the connection string
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 {}{
# Closing a connection
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

# Disable Recordset
Catch {$ m_rs Close}

# Query execution
Set ret [catch {$ m_rs Open $ sqlstr $ m_cn $ m_CursorType $ m_LockType} msg]
If {$ ret }{
Error "$ msg/n failed to execute the SQL statement:/n $ sqlstr"
}

# Check whether the SQL statement returns data
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 {}

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

# Disable Recordset
Catch {$ m_rs Close}

# Create and return to the data list
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"Database$ Tablename already exists in. "
}

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
}