程序思想:用SELECT name From sysobjects WHERE xtype = 'u'得到所有表,然后循环打开表,根据Rs_Colums.Fields(I).Name 得到字段名,FieldType(Rs_Colums.Fields(I).Type) 得到字段类型,Rs_Colums.Fields(I).DefinedSize '宽度由于Rs_Colums.Fields(I).Type返回类型是数字,程序中写了一个FieldType函数转化成中文类型Private Sub Command1_Click() Dim Cn As New ADODB.Connection Dim Rs_Table As New ADODB.Recordset Dim Rs_Colums As New ADODB.Recordset With Cn '定义连接 .CursorLocation = adUseClient .Provider = "sqloledb" .Properties("Data Source").Value = "LIHG" .Properties("Initial Catalog").Value = "NorthWind" .Properties("User ID") = "sa" .Properties("Password") = "sa" .Properties("prompt") = adPromptNever .ConnectionTimeout = 15 .Open
If .State = adStateOpen Then Rs_Table.CursorLocation = adUseClient '得到所有表名 Rs_Table.Open "SELECT name From sysobjects WHERE xtype = 'u'", Cn, adOpenDynamic, adLockReadOnly Rs_Table.MoveFirst Do While Not Rs_Table.EOF Debug.Print Rs_Table.Fields("name") Rs_Colums.CursorLocation = adUseClient Rs_Colums.Open "select top 1 * from [" & Rs_Table.Fields("name") & "]", Cn, adOpenStatic, adLockReadOnly For I = 0 To Rs_Colums.Fields.Count - 1 ' 循环所有列 Debug.Print Rs_Colums.Fields(I).Name '字段名 Debug.Print FieldType(Rs_Colums.Fields(I).Type) '字段类型 Debug.Print Rs_Colums.Fields(I).DefinedSize '宽度 Next Rs_Colums.Close Rs_Table.MoveNext Loop Rs_Table.Close Set Rs_Colums = Nothing Set Rs_Table = Nothing
Else MsgBox "数据库连接失败,请找系统管理员进行检查 !", 16, cProgramName End End If End With End Sub'********************************************************* '* 名称:FieldType '* 功能:返回字段类型 '* 用法:FieldType(nType as integer) '********************************************************* Function FieldType(nType As Integer) As String Select Case nType Case 128 FieldType = "BINARY" Case 11 FieldType = "BIT" Case 129 FieldType = "CHAR" Case 135 FieldType = "DATETIME" Case 131 FieldType = "DECIMAL" Case 5 FieldType = "FLOAT" Case 205 FieldType = "IMAGE" Case 3 FieldType = "INT" Case 6 FieldType = "MONEY" Case 130 FieldType = "NCHAR" Case 203 FieldType = "NTEXT" Case 131 FieldType = "NUMERIC" Case 202 FieldType = "NVARCHAR" Case 4 FieldType = "REAL" Case 135 FieldType = "SMALLDATETIME" Case 2 FieldType = "SMALLMONEY" Case 6 FieldType = "TEXT" Case 201 FieldType = "TIMESTAMP" Case 128 FieldType = "TINYINT" Case 17 FieldType = "UNIQUEIDENTIFIER" Case 72 FieldType = "VARBINARY" Case 204 FieldType = "VARCHAR" Case 200 FieldType = "" End Select End Function 此程序只是一个雏形,可以在此基础上开发成一个工具使用本程序在:VB 6.0 ,SQL SERVER 2000下运行通过注程序中须引用ActiveX Data Objects (ADO)
Dim Cn As New ADODB.Connection
Dim Rs_Table As New ADODB.Recordset
Dim Rs_Colums As New ADODB.Recordset With Cn '定义连接
.CursorLocation = adUseClient
.Provider = "sqloledb"
.Properties("Data Source").Value = "LIHG"
.Properties("Initial Catalog").Value = "NorthWind"
.Properties("User ID") = "sa"
.Properties("Password") = "sa"
.Properties("prompt") = adPromptNever
.ConnectionTimeout = 15
.Open
If .State = adStateOpen Then
Rs_Table.CursorLocation = adUseClient '得到所有表名
Rs_Table.Open "SELECT name From sysobjects WHERE xtype = 'u'", Cn, adOpenDynamic, adLockReadOnly
Rs_Table.MoveFirst
Do While Not Rs_Table.EOF
Debug.Print Rs_Table.Fields("name")
Rs_Colums.CursorLocation = adUseClient
Rs_Colums.Open "select top 1 * from [" & Rs_Table.Fields("name") & "]", Cn, adOpenStatic, adLockReadOnly
For I = 0 To Rs_Colums.Fields.Count - 1 ' 循环所有列
Debug.Print Rs_Colums.Fields(I).Name '字段名
Debug.Print FieldType(Rs_Colums.Fields(I).Type) '字段类型
Debug.Print Rs_Colums.Fields(I).DefinedSize '宽度
Next
Rs_Colums.Close
Rs_Table.MoveNext
Loop
Rs_Table.Close
Set Rs_Colums = Nothing
Set Rs_Table = Nothing
Else
MsgBox "数据库连接失败,请找系统管理员进行检查 !", 16, cProgramName
End
End If
End With
End Sub'*********************************************************
'* 名称:FieldType
'* 功能:返回字段类型
'* 用法:FieldType(nType as integer)
'*********************************************************
Function FieldType(nType As Integer) As String
Select Case nType
Case 128
FieldType = "BINARY"
Case 11
FieldType = "BIT"
Case 129
FieldType = "CHAR"
Case 135
FieldType = "DATETIME"
Case 131
FieldType = "DECIMAL"
Case 5
FieldType = "FLOAT"
Case 205
FieldType = "IMAGE"
Case 3
FieldType = "INT"
Case 6
FieldType = "MONEY"
Case 130
FieldType = "NCHAR"
Case 203
FieldType = "NTEXT"
Case 131
FieldType = "NUMERIC"
Case 202
FieldType = "NVARCHAR"
Case 4
FieldType = "REAL"
Case 135
FieldType = "SMALLDATETIME"
Case 2
FieldType = "SMALLMONEY"
Case 6
FieldType = "TEXT"
Case 201
FieldType = "TIMESTAMP"
Case 128
FieldType = "TINYINT"
Case 17
FieldType = "UNIQUEIDENTIFIER"
Case 72
FieldType = "VARBINARY"
Case 204
FieldType = "VARCHAR"
Case 200
FieldType = ""
End Select
End Function
此程序只是一个雏形,可以在此基础上开发成一个工具使用本程序在:VB 6.0 ,SQL SERVER 2000下运行通过注程序中须引用ActiveX Data Objects (ADO)
作者是lihonggen0
两位提供的方法给了我很大的帮助,现在还有一个问题:我要做的是一个数据库的查询,要求是能兼容查询各种数据库(包括db2,sql server等),在.net 的类函数库(或者某个控件)里面是不是有一个类可以提供“得到指定数据库的所有表名”的操作,向上层应用程序提供一个统一的接口(不用理会底层是什么DBMS)?