|
Option Explicit
Dim isConnect As Boolean '判断数据库是否连接成功
Dim ConADODB As New ADODB.Connection '用于连接MASTER系统数据库
Dim ResADODB As New ADODB.Recordset '用于获取所有数据库
'Dim ConADODB As New ADODB.Connection '用于连接用户数据库
Private Sub CboChooseDatabase_Click() '选择数据库，得到该数据库所有的表(只操作用户表）
Dim rs As New ADODB.Recordset
Call ConnectDatabase(CboChooseDatabase.Text,ConADODB)
CboTable.Clear
Dim criteria(3) As Variant
criteria(0) = CboChooseDatabase.Text
criteria(1) = Empty
criteria(2) = Empty
criteria(3) = "table"
Set rs = ConADODB.OpenSchema(adSchemaTables,criteria)
While Not rs.EOF
CboTable.AddItem (rs!TABLE_NAME)
rs.MoveNext
Wend
CboTable.Text = CboTable.List(0)
Call CboTable_Click
Dim i As Integer
rs.Close
ConADODB.Close
End Sub
Private Sub CboTable_Click() '选择表，得到表中所有字段名称
Dim strSql As String
Dim rs As New ADODB.Recordset
Call ConnectDatabase(CboChooseDatabase.Text,ConADODB)
strSql = " Select Name FROM SysColumns Where id=Object_Id('" & CboTable.Text & "')"
rs.Open strSql,ConADODB
CboTableField.Clear
Do While Not rs.EOF
CboTableField.AddItem rs!Name
rs.MoveNext
Loop
CboTableField.Text = CboTableField.List(0)
rs.Close
ConADODB.Close
End Sub
Private Sub CboTableField_Click()
TxtFieldName.Text = CboTableField.Text
End Sub
Private Sub CmdAlterDatabaseName_Click() '修改数据库名称
Dim strOldName As String
Dim strNewName As String
Dim strSql As String
strOldName = CboChooseDatabase.List(CbxIndex)
strNewName = CboChooseDatabase.Text
strSql = "Exec sp_renamedb '" & strOldName & "','" & strNewName & "' "
Call ConnectSting
ConADODB.Execute strSql
ConADODB.Close
End Sub
Private Sub CmdAlterTable_Click() '修改表的名称，该表必须存在
Dim strOldName As String
Dim strNewName As String
Dim strSql As String
strOldName = CboChooseDatabase.List(CbxIndex)
strNewName = CboChooseDatabase.Text
strSql = "Exec sp_renamedb '" & strOldName & "','" & strNewName & "' "
ConADODB.Execute strSql
End Sub
'创建一个新的数据库
Private Sub CmdCreateDatabase_Click()
Dim strNewDatabaseName As String
Dim strSql As String
Dim i As Integer
strNewDatabaseName = CboChooseDatabase.Text
For i = 0 To CboChooseDatabase.ListCount - 1
If CboChooseDatabase.List(i) = strNewDatabaseName Then
MsgBox "该数据库已经存在，请重新命名数据库！"
Exit Sub
End If
Next i
If Len(Trim(CboChooseDatabase.Text)) > 0 Then
CboChooseDatabase.AddItem (strNewDatabaseName)
Dim strNameData,strFileNameDataMdf As String
Dim strNameLog,strFileNameLogLdf As String
strNameData = strNewDatabaseName & "_data"
strFileNameDataMdf = "D:" & strNameData & ".mdf"
strNameLog = strNewDatabaseName & "_log"
strFileNameLogLdf = "D:" & strNameLog & ".ldf"
strSql = "create database " & strNewDatabaseName & " on primary(name=" & strNameData & ",filename='" & strFileNameDataMdf & "'"
strSql = strSql & ",size=5mb,maxsize=100mb,filegrowth=10%)log on(name=" & strNameLog & ",filename='" & strFileNameLogLdf & "',maxsize"
strSql = strSql & "=100mb,filegrowth=10%)"
Call ConnectSting
ConADODB.Execute strSql
MsgBox "数据库创建成功！"
Else
MsgBox "数据库名称不能为空，请命名！"
End If
ConADODB.Close
End Sub
Private Sub CmdDelDatabase_Click() '删除数据库，不能删除系统数据库
Dim strDataName As String
' Dim ConADODB As New ADODB.Connection
' On Error GoTo err
' ConADODB.State
strDataName = CboChooseDatabase.Text
Dim strSql As String
If strDataName <> "master" And strDataName <> "model" And strDataName <> "msdb" And strDataName <> "tempdb" And Mid(strDataName,1,13) <> "ReportServer$" Then
strSql = "drop database " & strDataName & ""
Call ConnectSting
ConADODB.Execute strSql
CboChooseDatabase.Clear
Call InitDB
Else
MsgBox "不能删除系统数据库！"
Exit Sub
End If
'err:
' MsgBox err.Description
ConADODB.Close
End Sub
Private Sub CmdDelTable_Click() '删除数据库中的一张表
Dim strDataName As String '待删除表所在的数据库
Dim strTableName As String '待删除的表名
Dim strSql As String
strDataName = CboChooseDatabase.Text
strTableName = CboTable.Text
If Trim(strDataName) = "" Then
MsgBox "没有选择数据库，请选择！"
Exit Sub
End If
If Trim(strTableName) = "" Then
MsgBox "没有选择表，请选择！"
Exit Sub
End If
Call ConnectDatabase(strDataName,ConADODB)
strSql = "if exists (select 1 from sysobjects where id=object_id('" & strTableName & "')and type='U')drop table " & strTableName & ""
If isConnect = False Then
MsgBox "没有连接成功数据库，请重新选择数据库！"
Exit Sub
Else
ConADODB.Execute strSql
End If
ConADODB.Close
End Sub
Private Sub InitDB()
Call ConnectSting
ConADODB.CommandTimeout = 20
'获取本地sql服务器中所有数据库
ResADODB.Open "sysdatabases",ConADODB,adOpenDynamic,adLockOptimistic
Dim strDataName As String
Do While Not ResADODB.EOF
strDataName = ResADODB.Fields("name").Value
If strDataName <> "master" And strDataName <> "model" And strDataName <> "msdb" And strDataName <> "tempdb" And Mid(strDataName,13) <> "ReportServer$" Then
CboChooseDatabase.AddItem (strDataName)
End If
ResADODB.MoveNext
Loop
Set ResADODB = Nothing
ConADODB.Close
End Sub
Private Sub Form_Load()
LvwNewTable.Enabled = False
LvwNewTable.BackColor = &H8000000B
Call InitDB
End Sub
Private Sub ConnectDatabase(databaseName As String,cn As ADODB.Connection) '为数据库创建连接对象并返回
Dim i As Integer
For i = 0 To CboChooseDatabase.ListCount
If Trim(CboChooseDatabase.List(i)) = Trim(databaseName) Then
cn.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;User ID=sa;PWD=密码;Initial Catalog=" & databaseName & ";Data Source=服务器名" '连接数据库字符串
cn.Open
isConnect = True
Exit Sub
End If
Next i
isConnect = False
MsgBox "选择的数据库不存在，请重新创建或选择！"
End Sub
Private Sub ConnectSting()
If ConADODB.State = 0 Then
ConADODB.ConnectionString = "Provider=SQLOLEDB;Persist Security Info=False;User ID=sa;PWD=密码;Initial Catalog=master;Data Source=服务器名" '连接数据库字符串
ConADODB.Open
End If
End Sub
代码还是有点问题，以后改正！有兴趣的朋友可以参考下......................... （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
