Disclaimer:
This code is free for anyone to use. No one
may sell it, lease it, rent it, or otherwise charge or collect fees for it.
Also by using this code you release me and the people you downloaded this
example code from, from any and all legal recourse for anything this code may
do to your database or computer systems.
As all of you know reading this
article "What is SQL-DMO, let alone SQL-NS". Well the myth is about to be
uncovered in this multipart demonstration. I plan to show you how to use each
of these features for database information, scheduling, and other information
purposes with some generic functions and examples. You can do anything that
SQL Server Enterprise Manager can do. Also some of the functions in SQL-NS
give more information than going through SQL Server EM. Why I don't know but
they do even thought they are supposed to be the same API function calls.
The only requirements are that you have good VB and SQL
Server experience. Whatever you do don't run this code on production boxes,
this is meant for example purposes only.
Definitions
SQL-DMO (Distributed Management Objects)
Is a collection of objects that
encapsulate SQL Server's database, scheduling, and replication management.
SQL-NS (Namespace)
Is a collection of objects that encapsulate SQL
Server's enterprise manager functionality.
Help references
BOK (Books Online)
SQL Distributed Management Objects
SQL Namespace
WROX
SQL Server 7.0 SQL-DMO, SQL-NS, & DTS
Note:
When programming in SQL-NS in VB there is a
missing file (feature) that Microsoft did not include called the "sqlns.hlp"
file so you will have to refer to my code for examples and to books online.
SQL-DMO
In this segment, we will explore the following using SQL-DMO
(the next segment will add in the SQL-NS):
1. How
to get a list of the servers via (frmMenu)
a. Mod1. GetSrvNames()
i.
SQL-DMO to get a list of all of the SQL Servers running on the domain
you are logged into.
ii.
In the following code we create a SQLDMO Application, and a NameList
object in which we fill with avaible SQL Server names running on the same
domain.
Public Function GetSrvNames()
Dim iCount As Integer
Dim DMOApp As SQLDMO.Application
Dim DMONameList As SQLDMO.NameList
On Error GoTo Err
' Create the Application object
Set DMOApp = New SQLDMO.Application
' Get the list of servers
Set DMONameList = DMOApp.ListAvailableSQLServers
'Get the server names
For iCount = 1 To DMONameList.Count
frmMenu.cmbSrvName.AddItem DMONameList(iCount)
Next
' Close the objects
Set DMONameList = Nothing
Set DMOApp = Nothing
Err:
Resume Next 'Replace with good error handling
End Function
2. How
to connect to a SQL Server (frmMenu)
a. Mod1.SQL_CONNECTOR(Form
Name as parameter)
i.
Connect to SQL Server via SQL-DMO
ii.
Below we create a SQLDMO Server object and then connect to it via
trusted connection or the "sa" login based on the option chosen in the initial
logon screen.
Public Function SQL_CONNECTOR(objForName As Object)
' SQLDMO Connect string
Set MySqlServer = CreateObject("SQLDMO.SQLServer")
If bConnected = True Then
MySqlServer.Connect ServerName:=sSRVNameDMO, _
Login:="sa", _
Password:=sPassword
Else
MySqlServer.LoginSecure = True
MySqlServer.Connect ServerName:=sSRVNameDMO
End If
End Function
3. How
to do some basic table maintenance and get the scripting (frmMaint)
a. Form_Load()
i.
SQL-DMO on how to get a list of databases on the server you are logged
into.
ii.
Here we use a simple combo box and populate it with all of the available
database names.
Private Sub Form_Load()
Dim Db As Object
On Error GoTo LOAD_ERROR
frmMaint.MousePointer = 13
Call SQL_CONNECTOR(frmMaint)
' Fill the Combo Box on the form with the available databases by
' using the SQL Server databases collection
For Each Db In MySqlServer.Databases
' Make sure is ok
If Db.Status <> 992 Or Db.Status <> 32768 Or Db.Status <> 32 Or Db.Status <> 512 _
Or Db.Status <> 192 Or Db.Status <> 256 Then
cmbDatabase.AddItem Db.Name
Else
MsgBox "Database: """ + Db.Name _
+ " "" is can not be accessed at this time.", _
vbCritical, "Database Error"
End If
Next
Set Db = Nothing
' Set the combo box to the first database listed.
If cmbDatabase.ListCount > 0 Then
cmbDatabase.ListIndex = 0
End If
' Get db infor on the selected database
Call DBInfo
LOAD_ERROR_Exit:
frmMaint.MousePointer = 0
Exit Sub
LOAD_ERROR:
Resume LOAD_ERROR_Exit
End Sub
b. cmdUpdateStats_Click()
i.
Update the (DBCC UPDATESTATISTICS) statistics for the currently selected
table
ii.
With this SQLDMO we can create a one touch button to run "DBCC
UPDATESTATISTICS" ( Hint. No more ISQL or having to remember the syntax )
Private Sub cmdUpdateStats_Click()
Dim WorkTable As SQLDMO.Table
Dim iX As Integer
On Error GoTo Up_Stats_Error
frmMaint.MousePointer = 13
DoEvents
' Execute Update Statistics command on selected tables
For iX = 0 To lstTables.Selected(lstTables.ListCount - 1)
Set WorkTable = WorkDB.Tables(lstTables.List(iX))
' Update Statistics on the Table - using the UpdateStatistics Method
WorkTable.UpdateStatistics
' Release the Work Table object
Set WorkTable = Nothing
Next iX
Up_Stats_Exit:
MsgBox "Satistics Updated", vbInformation, "Statistics Updated"
frmMaint.MousePointer = 0
Exit Sub
Up_Stats_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume Up_Stats_Exit
End Sub
c. cmdCheckIdent_Click()
i.
Check the identity column (DBCC CHECKIDENT)
ii.
This simple code issues another DBCC command to check the Identity
column of a table.
Private Sub cmdCheckIdent_Click()
Dim WorkTable As SQLDMO.Table
Dim iX As Integer
On Error GoTo Up_Identity_Error
frmMaint.MousePointer = 13
DoEvents
' Execute CheckIdentityValue command on selected tables
For iX = 0 To lstTables.Selected(lstTables.ListCount - 1)
Set WorkTable = WorkDB.Tables(lstTables.List(iX))
' Check Identity values on the Table - using the CheckIdentityValue Method
If WorkTable.Attributes = 1 Then
WorkTable.CheckIdentityValue
End If
' Release the Work Table object
Set WorkTable = Nothing
Next iX
Up_Identity_Exit:
MsgBox "Identity Values Checked", vbInformation, "Check Identity"
frmMaint.MousePointer = 0
Exit Sub
Up_Identity_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume Up_Identity_Exit
End Sub
d. cmdTruncate_Click()
i.
Truncate all of the data in a table (TRUNCATE TABLE)
ii.
Be careful with this code, it is the same as issing "TRUNCATE TABLE TableName,
and will delete all the data in that table just as fast as in the ISQL window.
Private Sub cmdTruncate_Click()
Dim WorkTable As SQLDMO.Table
Dim iX As Integer
Dim sTRUNOut As String
On Error GoTo Up_Check_Error
frmMaint.MousePointer = 13
DoEvents
If MsgBox("Do you want to truncate the tables selected?", vbYesNo, "Are you sure?") = vbYes Then
' Execute Truncate Table command on selected tables
For iX = 0 To lstTables.Selected(lstTables.ListCount - 1)
Set WorkTable = WorkDB.Tables(lstTables.List(iX))
' Use the TruncateData Method
WorkTable.TruncateData
MsgBox RTrim$(WorkTable.Name) & " Truncateded", vbInformation, "Table Truncate"
' Release the Work Table object
Set WorkTable = Nothing
Next iX
End If
Up_Check_Exit:
frmMaint.MousePointer = 0
Exit Sub
Up_Check_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume Up_Check_Exit
End Sub
e. cmdMemory_Click()
i.
Shows memory used by SQL Server (DBCC MEMUSAGE)
ii.
This DBCC command is in SQLDMO and is kept around for reverse
compatibility just like it says in BOL.
Private Sub cmdMemory_Click()
Dim WorkTable As SQLDMO.Table
Dim iX As Integer
Dim sTRUNOut As String
On Error GoTo Up_Check_Error
frmMaint.MousePointer = 13
DoEvents
' Check server memory
MsgBox WorkDB.GetMemoryUsage, vbInformation, "MemoryUsage"
Up_Check_Exit:
frmMaint.MousePointer = 0
Exit Sub
Up_Check_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume Up_Check_Exit
End Sub
4. How
to get Job Maintenance information (frmScheduler)
a. LoadTasks()
i.
Retrieves names and counts of all jobs on the SQL Server
ii.
This code simply goes through and gets a total count of all the jobs you
have and places their names in a listbox.
Private Sub LoadTasks()
Dim lTask As Object
On Error GoTo LoadTasks_Error
frmJobs.MousePointer = 13
lstJobs.Clear
For Each lTask In MySqlServer.JobServer.Jobs
lstJobs.AddItem lTask.Name
Next
LoadTasks_Exit:
frmJobs.MousePointer = 0
Set lTask = Nothing
Exit Sub
LoadTasks_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume LoadTasks_Exit
End Sub
b. LoadInfo()
i.
Retrieves information on the currently selected job
ii.
This long procedure is rather simple in that it retrieves basic
information on a job some of which may not be readily avaible even in EM, or
you might have to dig deep in the GUI to get to it.
Private Sub LoadInfo()
Dim iX As Integer
Dim WorkJob As SQLDMO.Job
Dim iJ As String
Dim sMonth As String
Dim sYear As String
Dim sDay As String
On Error GoTo LoadInfo_Error
frmJobs.MousePointer = 13
If lstJobs.ListIndex = -1 Then
Exit Sub
End If
For iX = lstJobs.ListCount - 1 To 0 Step -1
If lstJobs.Selected(iX) = True Then
' Set icount for the history and add job
Set WorkJob = SQLSRVJOB.Jobs(lstJobs.List(iX))
' Job owner
txtJobOwner.Text = RTrim$(WorkJob.Owner)
' Create date
txtDateCreated.Text = RTrim$(WorkJob.DateCreated)
' Run Status
iJ = RTrim$(WorkJob.CurrentRunStatus)
Select Case iJ
Case "3"
txtRunStatus.Text = "Job Between Retries"
Case "1"
txtRunStatus.Text = "Job is executing"
Case "4"
txtRunStatus.Text = "Job is idle"
Case "7"
txtRunStatus.Text = "All executtable steps completed"
Case "5"
txtRunStatus.Text = "Job Suspended"
Case "0"
txtRunStatus.Text = "Cannot determine status"
Case "6"
txtRunStatus.Text = "Awaiting step outcome"
Case "2"
txtRunStatus.Text = "Job is blocked"
End Select
' Run Step
txtRunStep.Text = RTrim$(WorkJob.CurrentRunStep)
' Last Modified
txtLastModDate.Text = RTrim$(WorkJob.DateLastModified)
' Description
txtDesc.Text = RTrim$(WorkJob.Description)
' Enabled
txtEnabled.Text = RTrim$(WorkJob.Enabled)
' LastRun Date
sYear = Left(RTrim$(WorkJob.LastRunDate), 4)
sMonth = Mid(RTrim$(WorkJob.LastRunDate), 5, 2)
sDay = Right(RTrim$(WorkJob.LastRunDate), 2)
If sYear = "0" And sMonth = "" And sDay = "0" Then
txtLastRunDate.Text = "Job never ran"
Else
txtLastRunDate.Text = Format(sMonth & sDay & sYear, "##/##/####")
' Last run time
txtLastRunDate.Text = txtLastRunDate.Text & " - " &
Format(RTrim$(WorkJob.LastRunTime), "##:##:##")
End If
' Next Run Date
sYear = Left(RTrim$(WorkJob.NextRunDate), 4)
sMonth = Mid(RTrim$(WorkJob.NextRunDate), 5, 2)
sDay = Right(RTrim$(WorkJob.NextRunDate), 2)
If sYear = "0" And sMonth = "" And sDay = "0" Then
txtNRunDate.Text = "No Run Date"
Else
txtNRunDate.Text = Format(sMonth & sDay & sYear, "##/##/####")
' Next Run Time
txtNRunDate.Text = txtNRunDate.Text & " - " &
Format(RTrim$(WorkJob.NextRunTime), "##:##:##")
End If
' Operator email
txtOprEmail.Text = RTrim$(WorkJob.OperatorToEmail)
' Operator netsend
txtOprNetSend.Text = RTrim$(WorkJob.OperatorToNetSend)
' Operator pager
txtOprPager.Text = RTrim$(WorkJob.OperatorToPage)
' Pager notification levels
iJ = RTrim$(WorkJob.PageLevel)
Select Case iJ
Case "6"
txtPagerLevel.Text = "Page regardless"
Case "3"
txtPagerLevel.Text = "Page regardless"
Case "2"
txtPagerLevel.Text = "Page on failure"
Case "0"
txtPagerLevel.Text = "Do not page"
Case "1"
txtPagerLevel.Text = "Page on success"
Case "4096"
txtPagerLevel.Text = "Invalid Value"
End Select
' Event Log level
iJ = RTrim$(WorkJob.EventlogLevel)
Select Case iJ
Case "0"
txtEventLog.Text = "Always"
Case "1"
txtEventLog.Text = "Log on success"
Case "2"
txtEventLog.Text = "Log on failure"
Case "3"
txtEventLog.Text = "Log on completion"
End Select
Set WorkJob = Nothing
End If
Next
LoadInfo_Exit:
frmJobs.MousePointer = 0
Exit Sub
LoadInfo_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume LoadInfo_Exit
End Sub
c. cmdRefresh_Click()
i.
Refreshes the information on the currently selected job.
ii.
Refreshes the jobs job list and count on the user screen ( just in case
something has changed )
Private Sub cmdRefresh_Click()
Dim WorkJob As SQLDMO.Job
Dim iX As Integer
On Error GoTo cmdRefresh_Error
frmJobs.MousePointer = 13
For iX = lstJobs.ListCount - 1 To 0 Step -1
If lstJobs.Selected(iX) = True Then
Set WorkJob = SQLSRVJOB.Jobs(lstJobs.List(iX))
WorkJob.Refresh
MsgBox "Job - " & WorkJob.Name & " refreshed.", vbInformation, "Job Status"
End If
Next
Call LoadTasks
cmdRefresh_Exit:
frmJobs.MousePointer = 0
Set WorkJob = Nothing
Exit Sub
cmdRefresh_Error:
Me.MousePointer = 0
Resume Next 'Replace with good error handling
Resume cmdRefresh_Exit
End Sub
I hope you find this information educational and learn from
it. You can built your own custom applications to do anything and then some
that you may rely heavily on EM for.
Other Code:
On to
Part 2 of this article...
» 
Comment and Contribute
