小弟经常查看数据库里面的数据查看表数据，要用对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
