EXPLORE.FRM
VERSION 4.00
Begin VB.Form frmMain
Caption = "SQL-DMO Explorer"
ClientHeight = 6705
ClientLeft = 180
ClientTop = 390
ClientWidth = 9240
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 7110
Left = 120
LinkTopic = "Form1"
ScaleHeight = 6705
ScaleWidth = 9240
Top = 45
Width = 9360
Begin VB.TextBox txtProperties
Height = 2535
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 13
Top = 4080
Width = 9015
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
Height = 375
Left = 8640
TabIndex = 4
Top = 120
Width = 495
End
Begin VB.ComboBox cboFour
Height = 315
Left = 6960
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 11
Top = 600
Width = 2175
End
Begin VB.ListBox lstFour
Height = 2985
Left = 6960
Sorted = -1 'True
TabIndex = 12
Top = 960
Width = 2175
End
Begin VB.CommandButton cmdConnect
Caption = "&Connect"
Height = 375
Left = 7560
TabIndex = 3
Top = 120
Width = 975
End
Begin VB.TextBox txtPassword
Height = 285
Left = 5880
PasswordChar = "*"
TabIndex = 2
Top = 120
Width = 1455
End
Begin VB.TextBox txtLogin
Height = 285
Left = 3360
TabIndex = 1
Top = 120
Width = 1455
End
Begin VB.TextBox txtServer
Height = 285
Left = 1200
TabIndex = 0
Top = 120
Width = 1455
End
Begin VB.ListBox lstThree
Height = 2985
Left = 4680
Sorted = -1 'True
TabIndex = 10
Top = 960
Width = 2175
End
Begin VB.ListBox lstTwo
Height = 2985
Left = 2400
Sorted = -1 'True
TabIndex = 8
Top = 960
Width = 2175
End
Begin VB.ListBox lstOne
Height = 2985
Left = 120
Sorted = -1 'True
TabIndex = 6
Top = 960
Width = 2175
End
Begin VB.ComboBox cboThree
Height = 315
Left = 4680
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 9
Top = 600
Width = 2175
End
Begin VB.ComboBox cboTwo
Height = 315
Left = 2400
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 7
Top = 600
Width = 2175
End
Begin VB.ComboBox cboOne
Height = 315
Left = 120
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 5
Top = 600
Width = 2175
End
Begin VB.Label lblPassword
Caption = "Password:"
Height = 255
Left = 4920
TabIndex = 16
Top = 120
Width = 855
End
Begin VB.Label lblLogin
Caption = "Login:"
Height = 255
Left = 2760
TabIndex = 15
Top = 120
Width = 615
End
Begin VB.Label lblServer
Caption = "SQL Server:"
Height = 255
Left = 120
TabIndex = 14
Top = 120
Width = 1095
End
End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub FillProperties(oObject As Object, txtText As Object)
On Error Resume Next
Dim oProperty As Object
frmMain.MousePointer = 11
With txtText
Select Case oObject.TypeOf
Case SQLOLEObj_Subscription
.Text = "Properties for " & oObject.ServerName & NL
Case Else
.Text = "Properties for " & oObject.Name & NL
End Select
For Each oProperty In oObject.Properties
.Text = .Text & oProperty.Name & ": " & oProperty.Value & NL
Next
End With
frmMain.MousePointer = 0
End Sub
Private Sub cboFour_Click()
If oCurrentThree Is Nothing Then Exit Sub
FillFour
End Sub
Private Sub cboOne_Click()
cboTwo.Clear
lstTwo.Clear
cboThree.Clear
lstThree.Clear
cboFour.Clear
lstFour.Clear
Set oCurrentOne = Nothing
Select Case cboOne.Text
Case "Databases"
cboTwo.AddItem "Defaults"
cboTwo.AddItem "Groups"
cboTwo.AddItem "Publications"
cboTwo.AddItem "Rules"
cboTwo.AddItem "StoredProcedures"
cboTwo.AddItem "SystemDataTypes"
cboTwo.AddItem "Tables"
cboTwo.AddItem "UserDefinedDataTypes"
cboTwo.AddItem "Users"
cboTwo.AddItem "Views"
Case "RemoteServers"
cboTwo.AddItem "RemoteLogins"
End Select
FillOne
End Sub
Private Sub cboThree_Click()
cboFour.Clear
lstFour.Clear
Set oCurrentThree = Nothing
Select Case cboThree.Text
Case "Articles"
cboFour.AddItem "Subscriptions"
End Select
If oCurrentTwo Is Nothing Then Exit Sub
FillThree
End Sub
Private Sub cboTwo_Click()
cboThree.Clear
lstThree.Clear
cboFour.Clear
lstFour.Clear
Set oCurrentTwo = Nothing
Select Case cboTwo.Text
Case "Tables"
cboThree.AddItem "Checks"
cboThree.AddItem "Columns"
cboThree.AddItem "Indexes"
cboThree.AddItem "Keys"
cboThree.AddItem "Triggers"
Case "Publications"
cboThree.AddItem "Articles"
End Select
If oCurrentOne Is Nothing Then Exit Sub
FillTwo
End Sub
Private Sub FillOne()
On Error Resume Next
lstOne.Clear
If cboOne.ListIndex = -1 Then Exit Sub
ReDim oCollection(0) As Object
GetCollection oSQLServer, (cboOne.Text), oCollection()
Dim i As Integer
For i = 1 To oCollection(0).Count
lstOne.AddItem oCollection(0)(i).Name
Next i
End Sub
Private Sub FillThree()
On Error Resume Next
lstThree.Clear
If cboThree.ListIndex = -1 Then Exit Sub
ReDim oCollection(0) As Object
GetCollection oCurrentTwo, (cboThree.Text), oCollection()
Dim i As Integer
For i = 1 To oCollection(0).Count
lstThree.AddItem oCollection(0)(i).Name
Next i
End Sub
Private Sub FillFour()
On Error Resume Next
lstFour.Clear
If cboFour.ListIndex = -1 Then Exit Sub
ReDim oCollection(0) As Object
GetCollection oCurrentThree, (cboFour.Text), oCollection()
Dim i As Integer
For i = 1 To oCollection(0).Count
Select Case oCollection(0)(i).TypeOf
Case SQLOLEObj_Subscription
lstFour.AddItem oCollection(0)(i).ServerName
Case Else
lstFour.AddItem oCollection(0)(i).Name
End Select
Next i
End Sub
Private Sub FillTwo()
On Error Resume Next
lstTwo.Clear
If cboTwo.ListIndex = -1 Then Exit Sub
ReDim oCollection(0) As Object
GetCollection oCurrentOne, (cboTwo.Text), oCollection()
Dim i As Integer
For i = 1 To oCollection(0).Count
lstTwo.AddItem oCollection(0)(i).Name
Next i
End Sub
Private Sub cmdConnect_Click()
On Error Resume Next
frmMain.MousePointer = 11
oSQLServer.DisConnect
oSQLServer.Connect txtServer.Text, txtLogin.Text, txtPassword.Text
With txtProperties
If Err.Number = 0 Then
.Text = "Properties for SQL Server " & oSQLServer.TrueName & NL
FillProperties oSQLServer, txtProperties
Else
.Text = Err.Source & " Error " & Err.Number - vbObjectError & ":" & NL
.Text = .Text & " " & Err.Description
End If
End With
frmMain.MousePointer = 0
lstOne.Clear
lstTwo.Clear
lstThree.Clear
lstFour.Clear
End Sub
Private Sub cmdExit_Click()
Unload frmMain
End Sub
Private Sub Form_Load()
On Error Resume Next
NL = Chr$(13) & Chr$(10)
Set oSQLServer = New SQLOLE.SQLServer
oSQLServer.LoginTimeout = 10
With cboOne
.Clear
.AddItem "Alerts"
.AddItem "Databases"
.AddItem "Devices"
.AddItem "Languages"
.AddItem "Logins"
.AddItem "Operators"
.AddItem "RemoteServers"
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
oSQLServer.DisConnect
oSQLServer.Close
End Sub
Private Sub lstFour_Click()
On Error Resume Next
Select Case cboFour.Text
Case "Subscriptions"
Set oCurrentFour = oCurrentThree.Subscriptions(lstFour.Text)
End Select
FillProperties oCurrentFour, txtProperties
End Sub
Private Sub lstOne_Click()
On Error Resume Next
Select Case cboOne.Text
Case "Databases"
Set oCurrentOne = oSQLServer.Databases(lstOne.Text)
Case "Devices"
Set oCurrentOne = oSQLServer.Devices(lstOne.Text)
Case "Languages"
Set oCurrentOne = oSQLServer.Languages(lstOne.Text)
Case "Logins"
Set oCurrentOne = oSQLServer.Logins(lstOne.Text)
Case "RemoteServers"
Set oCurrentOne = oSQLServer.RemoteServers(lstOne.Text)
Case "Alerts"
Set oCurrentOne = oSQLServer.Alerts(lstOne.Text)
Case "Operators"
Set oCurrentOne = oSQLServer.Operators(lstOne.Text)
End Select
lstTwo.Clear
lstThree.Clear
lstFour.Clear
FillTwo
FillProperties oCurrentOne, txtProperties
End Sub
Private Sub lstThree_Click()
On Error Resume Next
Select Case cboThree.Text
Case "Columns"
Set oCurrentThree = oCurrentTwo.Columns(lstThree.Text)
Case "Indexes"
Set oCurrentThree = oCurrentTwo.Indexes(lstThree.Text)
Case "Triggers"
Set oCurrentThree = oCurrentTwo.Triggers(lstThree.Text)
Case "Keys"
Set oCurrentThree = oCurrentTwo.Keys(lstThree.Text)
Case "Checks"
Set oCurrentThree = oCurrentTwo.Checks(lstThree.Text)
Case "Articles"
Set oCurrentThree = oCurrentTwo.Articles(lstThree.Text)
End Select
lstFour.Clear
FillFour
FillProperties oCurrentThree, txtProperties
End Sub
Private Sub lstTwo_Click()
On Error Resume Next
Select Case cboTwo.Text
Case "Defaults"
Set oCurrentTwo = oCurrentOne.Defaults(lstTwo.Text)
Case "Groups"
Set oCurrentTwo = oCurrentOne.Groups(lstTwo.Text)
Case "Rules"
Set oCurrentTwo = oCurrentOne.Rules(lstTwo.Text)
Case "StoredProcedures"
Set oCurrentTwo = oCurrentOne.StoredProcedures(lstTwo.Text)
Case "SystemDataTypes"
Set oCurrentTwo = oCurrentOne.SystemDatatypes(lstTwo.Text)
Case "Tables"
Set oCurrentTwo = oCurrentOne.Tables(lstTwo.Text)
Case "UserDefinedDataTypes"
Set oCurrentTwo = oCurrentOne.UserDefinedDatatypes(lstTwo.Text)
Case "Users"
Set oCurrentTwo = oCurrentOne.Users(lstTwo.Text)
Case "Views"
Set oCurrentTwo = oCurrentOne.Views(lstTwo.Text)
Case "RemoteLogins"
Set oCurrentTwo = oCurrentOne.RemoteLogins(lstTwo.Text)
Case "Publications"
Set oCurrentTwo = oCurrentOne.Publications(lstTwo.Text)
End Select
lstThree.Clear
lstFour.Clear
FillThree
FillProperties oCurrentTwo, txtProperties
End Sub