frmsqlsrvbrowse.frm

一款不错的档案VB

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form frmSQLSRVBrowse 
   Caption         =   "SQL Server Databases"
   ClientHeight    =   7890
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10095
   LinkTopic       =   "Form1"
   ScaleHeight     =   7890
   ScaleWidth      =   10095
   StartUpPosition =   3  'Windows Default
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid fgrdTable 
      Height          =   3495
      Left            =   0
      TabIndex        =   2
      Top             =   4320
      Width           =   10095
      _ExtentX        =   17806
      _ExtentY        =   6165
      _Version        =   393216
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   1560
      Top             =   720
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSQLSRVBrowse.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSQLSRVBrowse.frx":02FA
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSQLSRVBrowse.frx":131C
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvwTables 
      Height          =   4215
      Left            =   5040
      TabIndex        =   1
      Top             =   0
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   7435
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      Icons           =   "ImageList1"
      SmallIcons      =   "ImageList1"
      ColHdrIcons     =   "ImageList1"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Tables"
         Object.Width           =   7056
      EndProperty
   End
   Begin MSComctlLib.ListView lvwDatabases 
      Height          =   4215
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   7435
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      Icons           =   "ImageList1"
      SmallIcons      =   "ImageList1"
      ColHdrIcons     =   "ImageList1"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   1
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Databases on SEWS47"
         Object.Width           =   7585
      EndProperty
   End
End
Attribute VB_Name = "frmSQLSRVBrowse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const DB_PROVIDER = "SQLOLEDB"
Private Const SQL_SRV = "SEWS47"

Private cn As ADODB.Connection
Private rs As ADODB.Recordset
'

'*************************************************************************
'Sub:
'Purpose:
'*************************************************************************
Private Sub OpenConnection()
    Set cn = New ADODB.Connection
    
    With cn
        .Provider = DB_PROVIDER
        .ConnectionString = "Data Source=" & SQL_SRV & ";User ID=sa"
        .Open
    End With
    
End Sub


'*************************************************************************
'Sub:       ListAllServerDataBases()
'Purpose:   Lists all SQL Databases on server in connection object
'*************************************************************************
Private Sub ListAllServerDatabases()
    Dim rsDB As ADODB.Recordset
    Dim i As Integer
    
    
    lvwDatabases.ListItems.Clear
    i = 1
    Set rsDB = cn.OpenSchema(adSchemaCatalogs)
    
    While Not rsDB.EOF
        lvwDatabases.ListItems.Add i, "DB" & i, rsDB!CATALOG_NAME, 2, 2
        rsDB.MoveNext
        i = i + 1
    Wend
    
    rsDB.Close
    Set rsDB = Nothing
    
End Sub


'*************************************************************************
'Sub:       ListAllTables()
'Purpose:   List the tables in selected Database
'*************************************************************************
Private Sub ListAllTables(ByVal sDB As String)

    Dim rsTables As ADODB.Recordset
    Dim i As Integer
    Dim NewConnString As String
    
    
    lvwTables.ListItems.Clear
    lvwTables.ColumnHeaders(1).Text = "Tables in " & sDB & " database"
    NewConnString = "Data Source=" & SQL_SRV & ";User ID=sa" & ";Initial Catalog=" & sDB
    
    cn.Close
    cn.Open NewConnString
    
    i = 1
    Set rsTables = cn.OpenSchema(adSchemaTables)
    
    While Not rsTables.EOF
        
        If UCase(rsTables!TABLE_TYPE) = "TABLE" Then
            lvwTables.ListItems.Add i, "TABLE" & i, rsTables!TABLE_NAME, 3, 3
            i = i + 1
        End If
        
        rsTables.MoveNext
        
    Wend
    
    rsTables.Close
    Set rsTables = Nothing
    
End Sub

'*************************************************************************
'Sub:       ListAllTables()
'Purpose:   List the tables in selected Database
'*************************************************************************
Private Sub OpenTable(ByVal sTableName As String)
    
    Dim rsTableContents As ADODB.Recordset
    Dim sSQL As String
    Dim fld As ADODB.Field
    
    sSQL = "SELECT * FROM " & sTableName
    Set rsTableContents = New ADODB.Recordset
    rsTableContents.Open sSQL, cn
    

    Set fgrdTable.DataSource = rsTableContents
    'Set fgrdTable.DataMember = rsTableContents
    fgrdTable.Refresh
    
    
'    While Not rsTableContents.EOF
'        For Each fld In rsTableContents
'            dgrTables.a
'        Next fld
'
'        rsTableContents.MoveNext
'    Wend
    
    'MsgBox sTableName
    
End Sub



Private Sub Form_Load()
    Call OpenConnection
    Call ListAllServerDatabases
End Sub


Private Sub Form_Resize()

    On Error Resume Next

    With lvwDatabases
        .Top = ScaleTop
        .Height = 5000
        .Width = ScaleWidth / 2 - 50
    End With
    
    With lvwTables
        .Top = ScaleTop
        .Left = lvwDatabases.Left + lvwDatabases.Width
        .Height = 5000
        .Width = ScaleWidth / 2 - 50
    End With
    
    With fgrdTable
        .Top = lvwDatabases.Top + lvwDatabases.Height
        .Height = ScaleHeight - 5500
        .Width = ScaleWidth
    End With
        
End Sub

Private Sub lvwDatabases_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Call ListAllTables(Item.Text)
End Sub

Private Sub lvwTables_Click()
    Call OpenTable(lvwTables.SelectedItem.Text)
End Sub