VERSION 4.00 Begin VB.Form DMODemo BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Dialog Caption = "Microsoft SQL Server 6.0 - ""Personal"" DBA" ClientHeight = 6420 ClientLeft = 1695 ClientTop = 1920 ClientWidth = 6480 Height = 7110 Icon = "DMODemo.frx":0000 Left = 1635 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6420 ScaleWidth = 6480 Top = 1290 Width = 6600 Begin VB.TextBox Text1 BackColor = &H00FFFFFF& BeginProperty Font name = "Arial" charset = 1 weight = 700 size = 18 underline = 0 'False italic = -1 'True strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 540 Index = 1 Left = 2100 TabIndex = 30 TabStop = 0 'False Text = " DBA" Top = 90 Width = 1065 End Begin VB.TextBox Text1 BackColor = &H00800000& BeginProperty Font name = "Arial" charset = 1 weight = 700 size = 18 underline = 0 'False italic = -1 'True strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 540 Index = 0 Left = 180 TabIndex = 29 TabStop = 0 'False Text = " Personal" Top = 90 Width = 1935 End Begin VB.Line Line1 BorderColor = &H000000FF& X1 = 180 X2 = 3180 Y1 = 660 Y2 = 660 End Begin Threed.SSPanel StatusBar Align = 2 'Align Bottom Height = 315 Left = 0 TabIndex = 25 Top = 6105 Width = 6480 _version = 65536 _extentx = 11430 _extenty = 556 _stockprops = 15 borderwidth = 0 bevelinner = 1 alignment = 1 End Begin Threed.SSFrame SSFrame3 Height = 1455 Left = 120 TabIndex = 21 Top = 690 Width = 6105 _version = 65536 _extentx = 10769 _extenty = 2566 _stockprops = 14 caption = "Login Information" forecolor = 8421504 BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713} name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty shadowstyle = 1 Begin Threed.SSCommand bConnect Default = -1 'True Height = 345 Left = 4110 TabIndex = 31 Top = 240 Width = 1425 _version = 65536 _extentx = 2514 _extenty = 609 _stockprops = 78 caption = "&Connect" bevelwidth = 1 outline = 0 'False End Begin Threed.SSPanel SSPanel1 Height = 345 Index = 2 Left = 2040 TabIndex = 28 Top = 210 Width = 1965 _version = 65536 _extentx = 3466 _extenty = 609 _stockprops = 15 caption = "SSPanel1" bevelouter = 1 autosize = 3 Begin VB.TextBox MyServer Height = 315 Left = 15 TabIndex = 1 Top = 15 Width = 1935 End End Begin Threed.SSPanel SSPanel1 Height = 345 Index = 1 Left = 2040 TabIndex = 27 Top = 570 Width = 1965 _version = 65536 _extentx = 3466 _extenty = 609 _stockprops = 15 caption = "SSPanel1" bevelouter = 1 autosize = 3 Begin VB.TextBox MyLogin Height = 315 Left = 15 TabIndex = 2 Top = 15 Width = 1935 End End Begin Threed.SSPanel SSPanel1 Height = 345 Index = 0 Left = 2040 TabIndex = 26 Top = 930 Width = 1965 _version = 65536 _extentx = 3466 _extenty = 609 _stockprops = 15 caption = "SSPanel1" bevelouter = 1 autosize = 3 Begin VB.TextBox MyPassword Height = 315 Left = 15 TabIndex = 3 Top = 15 Width = 1935 End End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Password:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 210 TabIndex = 24 Top = 930 Width = 1185 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Login:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 210 TabIndex = 23 Top = 600 Width = 795 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Server:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 210 TabIndex = 22 Top = 300 Width = 795 End End Begin Threed.SSFrame SSFrame2 Height = 1995 Left = 90 TabIndex = 12 Top = 3990 Width = 6105 _version = 65536 _extentx = 10769 _extenty = 3519 _stockprops = 14 caption = "Objects in Database" forecolor = 8421504 BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713} name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty shadowstyle = 1 Begin VB.PictureBox Radios Appearance = 0 'Flat BackColor = &H00C0C0C0& BorderStyle = 0 'None Enabled = 0 'False ForeColor = &H80000008& Height = 1455 Left = 120 ScaleHeight = 1455 ScaleWidth = 2370 TabIndex = 14 TabStop = 0 'False Top = 510 Width = 2370 Begin VB.OptionButton DBType BackColor = &H00C0C0C0& Caption = "Tables" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 345 Index = 0 Left = 0 TabIndex = 18 TabStop = 0 'False Top = 0 Value = -1 'True Width = 1935 End Begin VB.OptionButton DBType BackColor = &H00C0C0C0& Caption = "Views" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 345 Index = 1 Left = 0 TabIndex = 17 TabStop = 0 'False Top = 330 Width = 1935 End Begin VB.OptionButton DBType BackColor = &H00C0C0C0& Caption = "Stored Procedures" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 345 Index = 2 Left = 0 TabIndex = 16 TabStop = 0 'False Top = 660 Width = 2175 End Begin VB.OptionButton DBType BackColor = &H00C0C0C0& Caption = "UserDefined Datatypes" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 345 Index = 3 Left = 0 TabIndex = 15 TabStop = 0 'False Top = 990 Width = 2415 End End Begin VB.ListBox TheList Height = 1395 Left = 2580 Sorted = -1 'True TabIndex = 13 TabStop = 0 'False Top = 450 Width = 3375 End Begin VB.Label Label2 BackColor = &H00C0C0C0& Caption = "Object Type:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Left = 150 TabIndex = 20 Top = 300 Width = 1305 End Begin VB.Label ObjectLabel BackColor = &H00C0C0C0& Caption = "Object List:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Left = 2580 TabIndex = 19 Top = 180 Width = 2895 End End Begin Threed.SSFrame SSFrame1 Height = 1815 Left = 120 TabIndex = 0 Top = 2130 Width = 6105 _version = 65536 _extentx = 10769 _extenty = 3201 _stockprops = 14 caption = "Server information" forecolor = 8421504 BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713} name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty shadowstyle = 1 Begin VB.ComboBox DeviceList Enabled = 0 'False Height = 300 Left = 2610 Style = 2 'Dropdown List TabIndex = 5 Top = 300 Width = 3225 End Begin VB.ComboBox LoginList Enabled = 0 'False Height = 300 Left = 2610 Style = 2 'Dropdown List TabIndex = 7 Top = 660 Width = 3225 End Begin VB.ComboBox RemoteList Enabled = 0 'False Height = 300 Left = 2610 Style = 2 'Dropdown List TabIndex = 9 Top = 1020 Width = 3225 End Begin VB.ComboBox DBList Enabled = 0 'False Height = 300 Left = 2610 Style = 2 'Dropdown List TabIndex = 11 Top = 1380 Width = 3225 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Devices:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 4 Left = 240 TabIndex = 10 Top = 330 Width = 1095 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Logins" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 5 Left = 240 TabIndex = 8 Top = 660 Width = 1095 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Remote Servers:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 6 Left = 240 TabIndex = 6 Top = 1020 Width = 1245 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "Database:" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 270 TabIndex = 4 Top = 1410 Width = 1095 End End Begin VB.Menu mfile Caption = "File" Begin VB.Menu mexit Caption = "&Exit" End End Begin VB.Menu mhelp Caption = "&Help" Begin VB.Menu mabout Caption = "&About" End End End Attribute VB_Name = "DMODemo" Attribute VB_Creatable = False Attribute VB_Exposed = False Dim CurrentType As Integer Dim Connected As Integer ''Dim OServer As New SQLOLE.SQLServer Private Sub bClose_Click() If Connected = True Then MousePointer = 11 OServer.DisConnect MousePointer = 0 End If Unload DMODemo ' End End Sub Private Sub bConnect_Click() If bConnect.Caption = "&Connect" Then If MyServer.Text = "" Then MsgBox "Enter a valid server name, login ID and password. Then press Connect.", 64, "Microsoft SQL Server" Exit Sub End If MousePointer = 11 StatusBar.Caption = "Connecting to \\" + MyServer.Text ' connect to the specified On Error Resume Next ' temporarily turn off errorchecking OServer.Connect ServerName:=MyServer.Text, _ Login:=MyLogin.Text, _ Password:=MyPassword.Text If Err <> 0 Then MsgBox Err.Description + " (Press F1 for Help)", 16, Err.Source & " Error", _ Err.HelpFile, Err.HelpContext MousePointer = 0 Exit Sub End If MousePointer = 11 On Error GoTo 0 StatusBar.Caption = "Connected to \\" + OServer.Name ' list all databases on the OServer StatusBar.Caption = "Get Database List" For Each MyDB In OServer.Databases ' always check that the database is accessable ' (database are inaccessible when being Loaded) If MyDB.Status <> SQLOLEDBStat_Inaccessible Then DBList.AddItem MyDB.Name Else MsgBox "Database: """ + MyDB.Name + " "" is Inaccessible at this time ", 16, "Microsoft SQL Server" End If Next ' List all devices on server StatusBar.Caption = "Get Device List" Dim MyDevice As SQLOLE.Device For Each MyDevice In OServer.Devices DeviceList.AddItem MyDevice.Name Next 'List all Logins on Server StatusBar.Caption = "Get Logins List" Dim MyLogins As SQLOLE.Login For Each MyLogins In OServer.Logins LoginList.AddItem MyLogins.Name Next 'List all RemoteServers StatusBar.Caption = "Get RemoteServers List" Dim MyRemote As SQLOLE.RemoteServer For Each MyRemote In OServer.RemoteServers RemoteList.AddItem MyRemote.Name Next ' set control properties Connected = True bConnect.Caption = "Disconnect" Radios.Enabled = True TheList.Enabled = True DeviceList.Enabled = True DeviceList.ListIndex = 0 LoginList.Enabled = True LoginList.ListIndex = 0 RemoteList.Enabled = True RemoteList.ListIndex = 0 DBList.Enabled = True StatusBar.Caption = "Get Object List" DBList.ListIndex = 0 StatusBar.Caption = "" MousePointer = 0 Else ' disconnect from server MousePointer = 11 Connected = False OServer.DisConnect bConnect.Caption = "Connect" DeviceList.Clear LoginList.Clear RemoteList.Clear DBList.Clear TheList.Clear DBList.Enabled = False DeviceList.Enabled = False LoginList.Enabled = False RemoteList.Enabled = False Radios.Enabled = False TheList.Enabled = False StatusBar.Caption = "Not Connected" MousePointer = 0 End If End Sub Private Sub DBList_Click() ' MousePointer = 11 DisplayList (CurrentType) ' MousePointer = 0 End Sub Private Sub Form_Load() '' Set OServer = CreateObject("SQLOLE.SQLServer") Dim OServer As New SQLOLE.SQLServer Connected = False End Sub Sub DisplayList(Index As Integer) Dim MyDB As String TheList.Clear MyDB = DBList.Text ObjectLabel = OServer.Name + "." + MyDB Select Case Index Case 0 ' tables ObjectList TheObjectType:=SQLOLEObj_UserTable, MyDataBase:=MyDB ObjectLabel = ObjectLabel + " Tables" Case 1 ' views ObjectList TheObjectType:=SQLOLEObj_View, MyDataBase:=MyDB ObjectLabel = ObjectLabel + " Views" Case 2 ' stored procedures ObjectList TheObjectType:=SQLOLEObj_StoredProcedure, MyDataBase:=MyDB ObjectLabel = ObjectLabel + " Stored Procedures" Case 3 ' user defined datatypes ObjectList TheObjectType:=SQLOLEObj_UserDefinedDatatype, MyDataBase:=MyDB ObjectLabel = ObjectLabel + " UDDTs" End Select End Sub Private Sub mabout_Click() fAbout.Show 1 End Sub Private Sub DBType_Click(Index As Integer) MousePointer = 11 CurrentType = Index DisplayList (Index) MousePointer = 0 End Sub Sub ObjectList(TheObjectType As Long, MyDataBase As String) Dim MyObject As Object For Each MyObject In OServer.Databases(MyDataBase).ListObjects(ObjectTypes:=TheObjectType) TheList.AddItem MyObject.Name Next End Sub Private Sub mexit_Click() If Connected = True Then MousePointer = 11 OServer.DisConnect MousePointer = 0 End If Unload DMODemo ' End End Sub Private Sub SSCommand1_Click() End Sub