usercontrol1.ctl

一个很Cool的数据库控件

On Error GoTo BestHandler
If RecordsetT.BOF = True Or RecordsetT.EOF = True Then
IfBOForEOF = True
End If
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Property

'load the field text to any object or variable
Public Property Get GetFieldData(FieldIndexOrName) As Variant
On Error GoTo BestHandler
GetFieldData = RecordsetT.Fields(FieldIndexOrName)
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Property

'do you to check if the account you use is working on the SQL Server or not? here is little check up
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

'Start the SQL Server
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

'Pause the SQL Server
Public Function PauseSQLServer(ServerName As String)
On Error GoTo BestHandler
SQLS.Name = ServerName
SQLS.Pause
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'Continue the SQL Server
Public Function ContinueSQLServer(ServerName As String)
On Error GoTo BestHandler
SQLS.Name = ServerName
SQLS.Continue
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'Stop the SQL Server
Public Function StopSQLServer(ServerName As String)
On Error GoTo BestHandler
SQLS.Name = ServerName
SQLS.Stop
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'Ye this delete any database on the SQL Server!, but done after you are connectd to the server
Public Function DeleteDatabase(DatabaseTName As String)
On Error GoTo BestHandler
SQLS.KillDatabase DatabaseTName
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'Add new dattbase to SQL Server, but the file must be ended with .MDF extension
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

'Here we connect to SQL Server to do some commands like Delete Datbase and Add Database
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

'This will disconnect you from the SQL Server, so you can't add new database or delete one...
Public Function DisconnectFromSQLServer()
On Error GoTo BestHandler
SQLS.Disconnect
BestHandler:
ErrorNumber = Err.Number
ErrorDescription = Err.Description

End Function

'You not sure if you connected or not, check your connection here
'Its not really made for testing the connection
'but it works perfectly (its just idea from me)
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

'Repair your damaged database, make access to faster!
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

'The following lines backup your database to any path you desire
Public Function BackupDatabaseToFile(DatabaseTName As String, Path As String)
On Error GoTo BestHandler
On Error Resume Next
'this used to creat the back utility by DMO
Dim BackMeUp As SQLDMO.Backup
'the following line must entered, don't work without it
Set BackMeUp = New SQLDMO.Backup
'variables
Dim DatabaseTFileName As String


'the above variable which will used for the backed up file
DatabaseTFileName = Environ$("TEMP") & "\" & DatabaseTName & ".bak"

'here we select which database
BackMeUp.Database = DatabaseTName

'the file path is selected here
BackMeUp.Files = DatabaseTFileName

'start the backing up, SQLS is used as the connection, you must be connected!
BackMeUp.SQLBackup SQLS


'move the set to your desire location
FileCopy DatabaseTFileName, Path & "\" & DatabaseTName & ".bak"
Kill Environ$("TEMP") & "\" & DatabaseTName & ".bak"


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

End Function

'we backed up a database before, right? how we restore it? here we go
Public Function RestoreDatabaseFromFile(DatabaseTName As String, Path As String)
On Error GoTo BestHandler
'the resote utility as object
Dim oRestore As SQLDMO.Restore
'the following line must be entered, don't work without it
Set oRestore = New SQLDMO.Restore

'get the file we wanna restore
FileCopy Path & "\" & DatabaseTName & ".bak", Environ$("TEMP") & "\" & DatabaseTName & ".bak"

'enter database name
oRestore.Database = DatabaseTName

'the file path set here
oRestore.Files = Environ$("TEMP") & "\" & DatabaseTName & ".bak"

'start the resorting up, the SQLS is our connection as object, you must be connected!
oRestore.SQLRestore SQLS

'clean out work
Kill Environ$("TEMP") & "\" & DatabaseTName & ".bak"

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

'this is the error handler by number
'this help you out like this:
'[
'If sqlSDBC1.ErrorNum = -54845484 Then
'Msgbox "Wrong Username!"
'End if
']
'its just example

Public Property Get ErrorNum() As Variant
ErrorNum = ErrorNumber
End Property

'this is error handler by name
'so you don't have to describe you problem
'in the msgbox or whereever you show your error
Public Property Get ErrorDes() As Variant
ErrorDes = ErrorDescription
End Property

'this show about me dialog box!
Public Function AboutMe()
Dim oFrm As About
Set oFrm = New About
oFrm.Show vbModal

End Function

'if you want to bind the table to MSFLEXGRID control, this is what you need
'Note: If you need to use FlexGrid control its ok,
'use the same code, but the table must have primary key
'to be able to bound to FlexGrid control

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

'This will bind any field to object like TextBox or 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

'If you wanna list all the databases in SQL Server this is what you need
'it works with object support the .AddItem future

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

'as above, but list the tables in database
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

'as above, but list fields in table
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

''''''''''''''''''''''''
'I'm sorry for any type error, I didn't check my notes
'back. Anyway, if you have any problem please contact me
'See the Ream Me.txt file first!
''''''''''''''''''''''''