usercontrol1.ctl

极易使用的SQL数据库操作控件 Ver 1.0 一个很容易使用的SQL服务器操作控件

ErrorDescription = Err.Description

End Property

'检查你的帐号是否在工作
Public Function CheckAccount(ServerName As String, Username As String, Password As String) As Boolean
On Error GoTo BestHandler
Dim SQLS2 As New SQLDMO.SQLServer

On Error GoTo BestHandler
SQLS2.Name = ServerName

On Error Resume Next

SQLS2.Connect ServerName, Username, Password


CheckAccount = True

Stop
BestHandler:
CheckAccount = False
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'启动 SQL 服务器
Public Function StartSQLServer(ServerName As String, Username As String, Password As String)
On Error GoTo BestHandler
SQLS.Start False, ServerName, Username, Password
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'暂停 SQL 服务器
Public Function PauseSQLServer(ServerName As String)
On Error GoTo BestHandler
SQLS.Name = ServerName
SQLS.Pause
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'继续 SQL 服务器
Public Function ContinueSQLServer(ServerName As String)
On Error GoTo BestHandler
SQLS.Name = ServerName
SQLS.Continue
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'停止 SQL 服务器
Public Function StopSQLServer(ServerName As String)
On Error GoTo BestHandler
SQLS.Name = ServerName
SQLS.Stop
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'删除数据库,必须连接到服务器
Public Function DeleteDatabase(DatabaseTName As String)
On Error GoTo BestHandler
SQLS.KillDatabase DatabaseTName
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'添加数据库到服务器，文件名必须以.MDF扩展名
Public Function AddDatabase(DatabaseTName As String, DatabaseTFileMDF As String)
On Error GoTo BestHandler
SQLS.AttachDBWithSingleFile DatabaseTName, DatabaseTFileMDF
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'连接到SQL服务器
Public Function ConnectToSQLServer(ServerName As String, Username As String, Password As String)
On Error GoTo BestHandler
SQLS.Connect ServerName, Username, Password
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'断开服务器连接
Public Function DisconnectFromSQLServer()
On Error GoTo BestHandler
SQLS.Disconnect
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'获取服务器连接状态
Public Property Get IsConnected() As Boolean
On Error GoTo BestHandler
If SQLS.IsPackage = SQLDMO_Unknown Then Width = 735 Else Height = 255


IsConnected = True

If Err.Number = -2147201022 Then IsConnected = False Else IsUserLogin = True
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Property

'修复数据库
Public Function RepairDatabase(DatabaseTName As String)
On Error GoTo BestHandler
SQLS.Databases(DatabaseTName).CheckAllocations SQLDMORepair_None

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'备份数据库到文件
Public Function BackupDatabaseToFile(DatabaseTName As String, Path As String)
On Error GoTo BestHandler
On Error Resume Next
Dim BackMeUp As SQLDMO.Backup
Set BackMeUp = New SQLDMO.Backup

Dim DatabaseTFileName As String


'临时文件
DatabaseTFileName = Environ$("TEMP") & "\" & DatabaseTName & ".bak"

'备份数据名
BackMeUp.Database = DatabaseTName

'文件路径
BackMeUp.Files = DatabaseTFileName

'开始备份,备份时需要保证服务器连接
BackMeUp.SQLBackup SQLS


'移动到目标位置
FileCopy DatabaseTFileName, Path & "\" & DatabaseTName & ".bak"
Kill Environ$("TEMP") & "\" & DatabaseTName & ".bak"


BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'从文件中还原数据库
Public Function RestoreDatabaseFromFile(DatabaseTName As String, Path As String)
On Error GoTo BestHandler
'还原对象
Dim oRestore As SQLDMO.Restore
'必须使用，否则不能工作
Set oRestore = New SQLDMO.Restore

'复制欢迎文件
FileCopy Path & "\" & DatabaseTName & ".bak", Environ$("TEMP") & "\" & DatabaseTName & ".bak"

'数据库名
oRestore.Database = DatabaseTName

'文件路径
oRestore.Files = Environ$("TEMP") & "\" & DatabaseTName & ".bak"

'开始还原，要保证服务器已经连接
oRestore.SQLRestore SQLS

'清除临时文件clean out work
Kill Environ$("TEMP") & "\" & DatabaseTName & ".bak"

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description
End Function

'返回错误号
Public Property Get ErrorNum() As Variant
ErrorNum = ErrorNumber
End Property

'错误描述
Public Property Get ErrorDes() As Variant
ErrorDes = ErrorDescription
End Property


'绑定到MSHFlexGrid网格控件
'提示：如果你想使用FlexGrid网格控件，必须把表设置为primary key
Public Function BindToMSHFlexGrid(ObjectName As Object)
On Error GoTo BestHandler

RecordsetT.Close

RecordsetT.Open SQLSta, DatabaseT, adOpenKeyset, adLockOptimistic

Set ObjectName.DataSource = RecordsetT
ObjectName.Refresh
RecordsetT.Requery -1

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description
End Function

'绑定到对象，如 TextBox 或者 Label 等
Public Function BindToObject(ObjectName As Object, DataFieldName As String)
On Error GoTo BestHandler


Set ObjectName.DataSource = RecordsetT

ObjectName.DataField = DataFieldName
ObjectName.Refresh

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'列表数据库
Public Function ListDatabases(ObjectName As Object)
On Error GoTo BestHandler
Set RecordsetT = DatabaseT.Execute("sp_databases")
Do Until RecordsetT.EOF
ObjectName.AddItem (RecordsetT.Fields("Database_Name"))
RecordsetT.MoveNext
Loop

RecordsetT.Close

RecordsetT.Open SQLSta, DatabaseT, adOpenKeyset, adLockOptimistic
RecordsetT.Requery -1

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description
End Function

'列表表
Public Function ListTables(ObjectName As Object)
On Error GoTo BestHandler

On Error Resume Next
RecordsetT.Close
ErrorNumber = ""
ErrorDescription = ""

RecordsetT.Open "SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_TYPE = 'BASE TABLE' AND OBJECTPROPERTY(OBJECT_ID(TABLE_NAME), 'IsMSShipped') = 0", DatabaseT, adOpenKeyset, adLockOptimistic

RecordsetT.Requery -1

Do Until RecordsetT.EOF
ObjectName.AddItem RecordsetT.Fields("TABLE_NAME")
RecordsetT.MoveNext
Loop

RecordsetT.Close



If SQLSta = "" Then
Else
RecordsetT.Open SQLSta, DatabaseT, adOpenKeyset, adLockOptimistic
RecordsetT.Requery -1
End If

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description
End Function

'列表字段
Public Function ListFields(ObjectName As Object, TableName As String)
On Error GoTo BestHandler
Dim nulls As String
Dim cnt As Integer



Set RecordsetT = DatabaseT.OpenSchema(adSchemaColumns, Array(Empty, Empty, TableName))

Do Until RecordsetT.EOF

cnt = cnt + 1


ObjectName.AddItem RecordsetT!column_name
RecordsetT.MoveNext
Loop

RecordsetT.Close

If SQLSta = "" Then
Else
RecordsetT.Open SQLSta, DatabaseT, adOpenKeyset, adLockOptimistic
RecordsetT.Requery -1
End If

BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description
End Function