VB快捷查看表结构和表数据

类别:.NET开发 点击:0 评论:0 推荐:
小弟经常查看数据库里面的数据查看表数据,要用对sql server 要有企业管理器或查询分析器
对oracle 用 sql plus , 来回切换真麻烦,于是编了一个数据库查看器
只针对 ms sql server 和 oracle 数据库,采用oledb连接数据库
本程序为VB程序,使用了 
Microsoft Internet Controls 和 Microsoft Windows Common Controls 6.0的控件库
此外还引用了 Microsoft ActiveX Data Objects 2.5 Library , 
Microsoft OLE DB Service Component 1.0 Type Library 的引用
程序用户界面为

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form frmViewData 
   Caption         =   "Form1"
   ClientHeight    =   6780
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9630
   Icon            =   "frmViewData.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6780
   ScaleWidth      =   9630
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdMin 
      Caption         =   "最小值"
      Height          =   390
      Left            =   7680
      TabIndex        =   11
      Top             =   0
      Width           =   885
   End
   Begin VB.CommandButton cmdMax 
      Caption         =   "最大值"
      Height          =   390
      Left            =   6735
      TabIndex        =   10
      Top             =   0
      Width           =   930
   End
   Begin VB.CommandButton cmdCount 
      Caption         =   "查询记录个数"
      Height          =   390
      Left            =   5325
      TabIndex        =   9
      Top             =   0
      Width           =   1380
   End
   Begin SHDocVwCtl.WebBrowser myGrid 
      Height          =   3525
      Left            =   3330
      TabIndex        =   8
      Top             =   3060
      Width           =   5070
      ExtentX         =   8943
      ExtentY         =   6218
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "http:///"
   End
   Begin VB.CommandButton cmdOpenTable 
      Caption         =   "打开表"
      Height          =   390
      Left            =   4170
      TabIndex        =   7
      Top             =   0
      Width           =   1110
   End
   Begin VB.CommandButton cmdQuery 
      Caption         =   "查询"
      Height          =   390
      Left            =   2895
      TabIndex        =   6
      Top             =   0
      Width           =   1230
   End
   Begin VB.CommandButton cmdRefreshSQL 
      Caption         =   "刷新SQL语句"
      Height          =   390
      Left            =   1260
      TabIndex        =   5
      Top             =   0
      Width           =   1590
   End
   Begin VB.PictureBox picUpDown 
      Height          =   105
      Left            =   3360
      MousePointer    =   7  'Size N S
      ScaleHeight     =   45
      ScaleWidth      =   4875
      TabIndex        =   4
      Top             =   2850
      Width           =   4935
   End
   Begin VB.TextBox txtSQL 
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1935
      Left            =   3525
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   750
      Width           =   4815
   End
   Begin VB.CommandButton cmdConn 
      Caption         =   "连接数据库"
      Height          =   390
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   1215
   End
   Begin VB.PictureBox picLeftRight 
      Height          =   5625
      Left            =   3030
      MousePointer    =   9  'Size W E
      ScaleHeight     =   5565
      ScaleWidth      =   30
      TabIndex        =   1
      Top             =   570
      Width           =   90
   End
   Begin MSComctlLib.TreeView tvwTable 
      Height          =   6015
      Left            =   -15
      TabIndex        =   0
      Top             =   405
      Width           =   2895
      _ExtentX        =   5106
      _ExtentY        =   10610
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   0
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      Checkboxes      =   -1  'True
      Appearance      =   1
   End
End
Attribute VB_Name = "frmViewData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private myConn As ADODB.Connection
Private myRecordSet As ADODB.Recordset
Private strConn As String
Private bolDraging As Boolean
Private lngLastPos As Long
Private Sub SetControlSize()
    On Error Resume Next
    tvwTable.Width = picLeftRight.Left - tvwTable.Left
    tvwTable.Height = Me.ScaleHeight - tvwTable.Top
    picLeftRight.Top = tvwTable.Top
    picLeftRight.Height = tvwTable.Height
    
    txtSQL.Left = picLeftRight.Left + picLeftRight.Width
    txtSQL.Top = tvwTable.Top
    txtSQL.Width = Me.ScaleWidth - txtSQL.Left
    txtSQL.Height = picUpDown.Top - txtSQL.Top
    
    picUpDown.Left = txtSQL.Left
    picUpDown.Width = txtSQL.Width
    
    myGrid.Left = txtSQL.Left
    myGrid.Top = picUpDown.Top + picUpDown.Height
    myGrid.Width = txtSQL.Width
    myGrid.Height = Me.ScaleHeight - myGrid.Top
End Sub
Private Sub cmdConn_Click()
    Dim dlg As New MSDASC.DataLinks
    Dim myC As New ADODB.Connection
    On Error GoTo ConnErr
    dlg.hWnd = Me.hWnd
    myC.ConnectionString = strConn
    If dlg.PromptEdit(myC) = True Then
        strConn = myC.ConnectionString
        If myConn.State = 1 Then
            myConn.Close
        End If
        myConn.ConnectionString = strConn
        myConn.Open
        RefreshView
        txtSQL.Text = strConn
    End If
    Set myC = Nothing
    Set dlg = Nothing
    Exit Sub
ConnErr:
    MsgBox Err.Description, vbCritical, "系统错误"
    Set myC = Nothing
    Set dlg = Nothing
End Sub
Private Sub cmdCount_Click()
    Dim strSQL  As String
    
    
    If Not tvwTable.SelectedItem Is Nothing Then
        If tvwTable.SelectedItem.Parent Is Nothing Then
            strSQL = "select count(*) from " & tvwTable.SelectedItem.Text
        Else
            strSQL = "select count(*) from " & tvwTable.SelectedItem.Parent.Text
        End If
        txtSQL.Text = strSQL
        cmdQuery_Click
    End If
End Sub
Private Sub cmdMax_Click()
    If Not tvwTable.SelectedItem Is Nothing Then
        If Not tvwTable.SelectedItem.Parent Is Nothing Then
            txtSQL.Text = "select max(" & tvwTable.SelectedItem.Text & ") From " & tvwTable.SelectedItem.Parent.Text
            cmdQuery_Click
        End If
    End If
End Sub
Private Sub cmdMin_Click()
    If Not tvwTable.SelectedItem Is Nothing Then
        If Not tvwTable.SelectedItem.Parent Is Nothing Then
            txtSQL.Text = "select min(" & tvwTable.SelectedItem.Text & ") From " & tvwTable.SelectedItem.Parent.Text
            cmdQuery_Click
        End If
    End If
End Sub
Private Sub cmdOpenTable_Click()
    Dim strSQL  As String
    Dim strProvider As String
    strProvider = VBA.Strings.LCase(myConn.Provider)
    
    If Not tvwTable.SelectedItem Is Nothing Then
        If tvwTable.SelectedItem.Parent Is Nothing Then
            strSQL = tvwTable.SelectedItem.Text
        Else
            strSQL = tvwTable.SelectedItem.Parent.Text
        End If
        If VBA.Strings.InStr(1, strProvider, "oracle") > 0 Then
            strSQL = "Select * From " & strSQL & " Where rownum<200"
        Else
            strSQL = "select  top 200 * From " & strSQL
        End If
        txtSQL.Text = strSQL
        cmdQuery_Click
    End If
End Sub
Private Sub cmdQuery_Click()
    Dim myRS As New ADODB.Recordset
    Dim strData As String
    Dim intFH As Integer
    Dim lCount As Long
    Dim lRecordCount As Long
    intFH = VBA.FreeFile()
    On Error GoTo QueryErr
    myRS.Open txtSQL.Text, myConn, adOpenStatic, adLockReadOnly, adCmdText
    Open App.Path & "\temp.htm" For Output As #intFH
    Print #intFH, "<html><head><title>查询结果</title></head><style>TD {FONT-FAMILY: 宋体; FONT-SIZE: 9pt}</style><body topmargin='1' leftmargin='1' rightmargin='1' bottommargin='1' bgcolor='#c3c3c3'><table cellspacing='0' rules='all' bordercolor='#999999' border='1'  style='border-color:#CC0066; border-collapse:collapse;  ' bgcolor='#f1f1f1'>"
    Print #intFH, "<tr style='background-color:#c2c2c2;'>"
    Print #intFH, "<td><b>SEQ</b></td>"
    For lCount = 0 To myRS.Fields.Count - 1
        Print #intFH, "<td>" & myRS.Fields(lCount).Name & "</td>"
    Next
    lRecordCount = 0
    Do Until myRS.EOF
        Print #intFH, "<tr><td>" & lRecordCount & "</td>"
        For lCount = 0 To myRS.Fields.Count - 1
            If IsNull(myRS.Fields(lCount).Value) Then
                strData = "&lt;NULL&gt;"
            Else
                strData = myRS.Fields(lCount).Value
                If VBA.Strings.InStr(1, strData, "<") > 0 Then
                    strData = VBA.Strings.Replace(strData, "<", "&lt;")
                    strData = VBA.Strings.Replace(strData, ">", "&gt;")
                End If
            End If
            Print #intFH, "    <td>" & strData & "</td>"
        Next
        Print #intFH, "</tr>"
        myRS.MoveNext
        lRecordCount = lRecordCount + 1
    Loop
    
    Print #intFH, "</table>"
    Print #intFH, "共返回 " & lRecordCount & " 条记录 ," & myRS.Fields.Count & " 个栏目"
    Print #intFH, "</body></html>"
    
    Close #intFH
    myGrid.Navigate App.Path & "\temp.htm"
    Me.Caption = "共返回 " & myRS.RecordCount & " 条记录"
    myRS.Close
    Set myRS = Nothing
    Exit Sub
QueryErr:
    VBA.FileSystem.Reset
    Set myRS = Nothing
    MsgBox Err.Description, vbCritical, "系统错误"
    On Error GoTo 0
End Sub
Private Sub cmdRefreshSQL_Click()
    Dim TableNode As MSComctlLib.Node
    Dim FieldNode As MSComctlLib.Node
    Dim myNode As MSComctlLib.Node
    Dim strSQL As String
    Dim strTable As String
    If tvwTable.Nodes.Count > 0 Then
        For Each myNode In tvwTable.Nodes
            If myNode.Checked = True And (Not myNode.Parent Is Nothing) Then
                If strSQL = "" Then
                    strSQL = "   " & myNode.Parent.Text & "." & myNode.Text
                Else
                    strSQL = strSQL & " ," & vbCrLf & "   " & myNode.Parent.Text & "." & myNode.Text
                End If
                If VBA.Strings.InStr(1, strTable, myNode.Parent.Text & ",") <= 0 Then
                    strTable = strTable & vbCrLf & myNode.Parent.Text & ","
                End If
                
            End If
        Next
        If strSQL <> "" Then
            txtSQL.Text = "Select " & vbCrLf & strSQL & vbCrLf & " From " & VBA.Strings.Left(strTable, VBA.Strings.Len(strTable) - 1)
        End If
    End If
End Sub
Private Sub Form_Load()
    myGrid.Navigate "about:blank"
    bolDraging = False
    picLeftRight.BorderStyle = 0
    picUpDown.BorderStyle = 0
    Set myConn = New ADODB.Connection
    Set myRecordSet = New ADODB.Recordset
    strConn = VBA.GetSetting(App.Title, Me.Name, "conn")
    On Error GoTo LoadErr
    If strConn <> "" Then
        myConn.Open strConn
        RefreshView
    End If
    
    Exit Sub
LoadErr:
    MsgBox Err.Description, vbCritical, "系统错误"
    On Error GoTo 0
End Sub
Private Sub RefreshView()
    Dim strProvider As String
    Dim strSQL As String
    Dim strTableName As String
    Dim TableNode As MSComctlLib.Node
    Dim FieldNode As MSComctlLib.Node
    
    Dim myRS As New ADODB.Recordset
    On Error GoTo RefreshErr
    
    strProvider = VBA.Strings.LCase(myConn.Provider)
    tvwTable.Visible = False
    tvwTable.Nodes.Clear
    tvwTable.Visible = True
    Me.MousePointer = 11
    Me.Refresh
    If VBA.Strings.InStr(1, strProvider, "oracle") > 0 Then
        strSQL = "Select TName,CName,coltype,width  From Col Order by TName,CName"
    Else
        strSQL = "select  sysobjects.name ,syscolumns.name  ,systypes.name ,syscolumns.length ,syscolumns.xtype from syscolumns,sysobjects,systypes where syscolumns.id=sysobjects.id and syscolumns.xtype=systypes.xtype and sysobjects.type='U' and systypes.name <>'_default_' and systypes.name<>'sysname' order by sysobjects.name,syscolumns.name"
    End If
    myRS.Open strSQL, myConn, adOpenStatic, adLockReadOnly, adCmdText
    
    Do Until myRS.EOF
        If strTableName <> myRS.Fields(0).Value Then
            strTableName = myRS.Fields(0).Value
            Set TableNode = tvwTable.Nodes.Add()
            TableNode.Text = strTableName
        End If
        Set FieldNode = tvwTable.Nodes.Add(TableNode.Index, tvwChild)
        FieldNode.Text = myRS.Fields(1).Value
        
        myRS.MoveNext
    Loop
    myRS.Close
    Set myRS = Nothing
    Me.MousePointer = 0
    Exit Sub
RefreshErr:
    Set myRS = Nothing
    Me.MousePointer = 0
    On Error GoTo 0
End Sub
 
Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        SetControlSize
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If myConn.ConnectionString <> "" Then
        VBA.SaveSetting App.Title, Me.Name, "conn", myConn.ConnectionString
    End If
    If myConn.State = 1 Then
        myConn.Close
    End If
    Set myConn = Nothing
    Set myRecordSet = Nothing
    
End Sub
Private Sub picLeftRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bolDraging = True
    lngLastPos = X
End Sub
Private Sub picLeftRight_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bolDraging = True Then
        Dim lPos As Long
        lPos = picLeftRight.Left + X - lngLastPos
        If lPos < 1000 Then
            lPos = 1000
        End If
        If lPos > Me.ScaleWidth - 1000 Then
            lPos = Me.ScaleWidth - 1000
        End If
        picLeftRight.Left = lPos
        SetControlSize
    End If
End Sub
Private Sub picLeftRight_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bolDraging = False
End Sub
 
Private Sub picUpDown_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bolDraging = True
    lngLastPos = Y
End Sub
Private Sub picUpDown_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If bolDraging = True Then
        Dim lPos As Long
        lPos = picUpDown.Top + Y - lngLastPos
        If lPos < 1000 Then
            lPos = 1000
        End If
        If lPos > Me.ScaleHeight - 1000 Then
            lPos = Me.ScaleHeight - 1000
        End If
        picUpDown.Top = lPos
        SetControlSize
    End If
End Sub
Private Sub picUpDown_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bolDraging = False
End Sub
Private Sub tvwTable_NodeCheck(ByVal Node As MSComctlLib.Node)
    Dim myNode As MSComctlLib.Node
    Dim bolCheck As Boolean
    If Not Node Is Nothing Then
        If Node.Parent Is Nothing Then
            Set myNode = Node.Child
            Do Until myNode Is Nothing
                myNode.Checked = Node.Checked
                Set myNode = myNode.Next
            Loop
        Else
            bolCheck = False
            Set myNode = Node.FirstSibling
            Do Until myNode Is Nothing
                If myNode.Checked = True Then
                    bolCheck = True
                    Exit Do
                End If
                Set myNode = myNode.Next
            Loop
            Node.Parent.Checked = bolCheck
        End If
    End If
End Sub

本文地址:http://com.8s8s.com/it/it44189.htm