.NET开发：VB快捷查看表结构和表数据
热点排行
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 = "<NULL>" Else strData = myRS.Fields(lCount).Value If VBA.Strings.InStr(1, strData, "<") > 0 Then strData = VBA.Strings.Replace(strData, "<", "<") strData = VBA.Strings.Replace(strData, ">", ">") 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