dbanalyzer.ebf

eVB 数据浏览器

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Style           =   1
   End
   Begin VBCE.CommandButton cmdViewRecs 
      Height          =   252
      Left            =   1560
      TabIndex        =   3
      Top             =   3600
      Visible         =   0   'False
      Width           =   1692
      _cx             =   2984
      _cy             =   444
      BackColor       =   12648384
      Caption         =   "View Record"
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   7.8
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Style           =   1
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub Form_Load()
    lblDispMsg.Caption = "Press the button above to Start"
    
    'Use the BtnShow function to hide and display as required
    BtnShow ("100000000")
End Sub


Private Sub cmdFirst_Click()
    'Move to the First Record
    rsWorkingTbl.MoveFirst
    GridRec_ReFill
    lblDispMsg.Caption = rsWorkingTbl.AbsolutePosition & " / " & iRecCnt
End Sub

Private Sub cmdLast_Click()
    'Move to the Last Record
    rsWorkingTbl.MoveLast
    GridRec_ReFill
    lblDispMsg.Caption = rsWorkingTbl.AbsolutePosition & " / " & iRecCnt
End Sub

Private Sub cmdNext_Click()
    ' Move to the Next Record
    
    If Not rsWorkingTbl.EOF Then rsWorkingTbl.MoveNext
    'If you don't check for EOF again you will get an error
    ' before EOF registers
    If Not rsWorkingTbl.EOF Then
        GridRec_ReFill
        lblDispMsg.Caption = rsWorkingTbl.AbsolutePosition & " / " & iRecCnt
    Else
        lblDispMsg.Caption = "End Of Record"
    End If
End Sub

Private Sub cmdPrev_Click()
    'Move to The Previous Record
    
    If Not rsWorkingTbl.BOF Then rsWorkingTbl.MovePrevious
    'If you don't check fore BOF again you will get an error
    ' before BOF registers
    If Not rsWorkingTbl.BOF Then
        GridRec_ReFill
        lblDispMsg.Caption = rsWorkingTbl.AbsolutePosition & " / " & iRecCnt
    Else
        lblDispMsg.Caption = "Beginning Of File"
    End If
End Sub


Private Sub cmdViewRecs_Click()
    'View One Record at a Time
    
    Me.List1.Visible = False

    'Open the rsWorkingTbl Record set with the LoadRecSet
    'function location in MAIN Module
        
    LoadRecSet
    
    'Open Grid to view records on at a time
    Grid1.Visible = False
    rsWorkingTbl.MoveFirst
    GridRec_Fill
    
    txtBox.Height = 492
    Me.txtBox.Visible = True
    BtnShow ("000001111")
    Me.lblDispMsg.Caption = "Use the buttons to navigate"
End Sub


Private Sub cmdGetDatabase_Click()
    'Open Dialog Box and Select File
    
    Dim sDataBase As String
    
    CommonDialog1.Filter = "Database|*.mdb;*.cdb"
    CommonDialog1.ShowOpen
    sDataBase = CommonDialog1.FileName
    
    'Read In the Tables
    LoadDB sDataBase

    Me.lblDispMsg.Caption = "Select Table or SQL Retreival"
    
    cmdGetTable.Visible = True

    BtnShow ("011000000")
    
    'Hide Instructions
    Me.lblDesc1.Visible = False
    Me.lblDesc2.Visible = False
    Me.Line1.Visible = False
    Me.Line2.Visible = False
    Me.Line3.Visible = False
    Me.Line4.Visible = False
    Me.Line5.Visible = False
                 
End Sub

Private Sub cmdGetTable_Click()
    'Display ComboBox with the List of Tables
    
    txtBox = " "
    LoadList
    List1.Visible = True
    List1.SetFocus
    BtnShow ("000110000")
    
    Me.lblDispMsg.Caption = "Select Table from Combo Box Above"
             
End Sub


Private Sub cmdReturn_Click()
    'Check to see which set of buttons is currently visible
    'hide them and make the set before visible
    
    If Me.cmdPrev.Visible = True Then
        'If navigation buttons are visible then
        ' display the View Selection Buttons
        BtnShow ("000110000")
        Grid1.Visible = False
        txtBox.Visible = False
        Me.lblDispMsg.Caption = "Select View Type"
        Exit Sub
    End If
    If Me.cmdViewGrid.Visible = True Then
        'If the View Grid/Records button are visible
        'then display the Select Table vs. SQL buttons
        BtnShow ("011000000")
        Grid1.Visible = False
        txtBox.Visible = False
        Me.lblDispMsg.Caption = "Select Table or SQL Retreival"
        Me.cmdViewGrid.Width = 1572
        Me.cmdViewGrid.Enabled = True
        Exit Sub
    End If
    If Me.cmdGetTable.Visible = True Then
        'If the view table buttons is visible then display
        'the Get Database button
        BtnShow ("100000000")
        List1.Visible = False
        txtBox.Visible = False
        Exit Sub
        lblDispMsg.Caption = "Press the button above to Start"
    End If
    If Me.cmdGetDataBase.Visible = True Then
        'If the Get Database button is visibl then
        'quit Applicatin
        App.End
    End If
End Sub


Private Sub cmdSQL_Click()
    'Display Text Box to Enter Select Statement
    
    lblDispMsg.Caption = "Enter SELECT Statement"
    Grid1.Visible = False
    
    'Expand the Height of the txtBox to Allow to type in a
    'larger SELECT statment
    txtBox.Height = 2052
    txtBox.Visible = True
    txtBox = ""
    BtnShow ("000100000")
    Me.cmdViewGrid.Width = 3252
End Sub

Private Sub cmdViewGrid_Click()
    'Display Grid View, show all recrods at once

    Me.List1.Visible = False
    Me.lblDispMsg.Caption = "Loading Database Please Wait"
    Screen.MousePointer = 11
    LoadRecSet
    DispGrid List1.Text
    txtBox.Height = 492
    Me.txtBox.Visible = True
    BtnShow ("000110000")
    Screen.MousePointer = 0
    If cmdViewGrid.Width > 1600 Then cmdViewGrid.Enabled = False
    
End Sub




Private Sub Form_OKClick()
    App.End
End Sub




Private Sub LoadList()
    'Load all the Table Names in to the ComboBox
    
    Dim RecordCount As Integer
    Dim xCounter1 As Integer
    
    'Load List of Tables in the rsTables Recordset
    Set rsTables = CreateObject("ADOCE.Recordset.3.0")
    rsTables.Open "MSysTables", conndb
    RecordCount = rsTables.RecordCount
    
    ' If you do not clear the list then, the list of
    ' tables in the combo box will grow, displaying the tables
    ' from a previously selected database
    List1.Clear
    
    For xCounter1 = 0 To RecordCount - 1
        List1.AddItem rsTables.Fields("TableName").Value
        rsTables.MoveNext
    Next
    
    rsTables.Close
    Set rsTables = Nothing
End Sub





Private Sub DispGrid(sTableName As String)
    'Display DB-Grid
    '---------------
    On Error Resume Next
    
    Dim i As Integer

    'Hide grid while being populated, it will load faster
    Grid1.Visible = False
    Grid1.Clear
    
    lblDispMsg.Caption = "Loading Grid Please Wait"
    lblDispMsg.ForeColor = vbRed
        
    Grid1.Cols = rsWorkingTbl.Fields.Count
    Grid1.Rows = 1
        
    Grid1.ColWidth(1) = 1000
    
    If rsWorkingTbl.Fields.Count > 0 Then
        
        For i = 0 To rsWorkingTbl.Fields.Count - 1
            Grid1.Col = i
            Grid1.Text = rsWorkingTbl.Fields(i).Name
            Grid1.CellBackColor = &HC0C0C0
        Next
    
        Do While Not rsWorkingTbl.EOF
            Grid1.Rows = Grid1.Rows + 1
            Grid1.Row = Grid1.Rows - 1
                
            For i = 0 To rsWorkingTbl.Fields.Count - 1
                Grid1.Col = i
                Grid1.Text = rsWorkingTbl.Fields(i)
            Next
        
            rsWorkingTbl.MoveNext
        Loop
        
        Grid1.Visible = True
    Else
        MsgBox "Sorry No Records"
    End If
    Grid1.Row = 0
    Grid1.Col = 0
    
    lblDispMsg.Caption = "BSB DataBase Analyzer"
End Sub




Private Sub GridRec_Fill()
    'Display DB-Grid For individual records
    
    Dim sRec As String
    
    'Hide the gird when you populate it, it will load, faster
    'and the User won't get dizy looking at it
    
    Grid1.Visible = False
    Grid1.Clear
        
    Grid1.Cols = 2
    Grid1.Rows = 1
    
    Grid1.Col = 1
    Grid1.ColWidth(1) = 2420
    Grid1.Col = 0
         
    rsRecords.MoveFirst
    
    Do While Not rsRecords.EOF
        sRec = rsRecords.Fields("FieldName")
        Grid1.Col = 0
        Grid1.Text = sRec
        
        Grid1.Col = 1
        'MsgBox sRec & " = " & rsWorkingTbl.Fields(sRec)
        If IsNull(rsWorkingTbl.Fields(sRec)) Then
            Grid1.Text = " "
        Else
            Grid1.Text = rsWorkingTbl.Fields(sRec)
        End If
        
        rsRecords.MoveNext
        'rsWorkingTbl.Movenext

        Grid1.Rows = Grid1.Rows + 1
        Grid1.Row = Grid1.Rows - 1
    Loop
    
    Grid1.Visible = True
    lblDispMsg.Caption = "BSB DataBase Analyzer"
    Grid1.Row = 0
    Grid1.Col = 0

End Sub



Private Sub GridRec_ReFill()
    'Display DB-Grid For individual records
    'Assuming it has been created the first time by
    'GridRec_Fill function
    
    Dim sRec As String
    Dim iRecNo As Integer
    Dim i As Integer
    
    'Hide text box and Grid while being updated
    txtBox.Visible = False
    Grid1.Visible = False
    Grid1.Col = 1
    
    iRecNo = rsRecords.RecordCount
    
    For i = 1 To iRecNo
        Grid1.Row = i - 1
        Grid1.Col = 0
        sRec = Grid1.Text
        Grid1.Col = 1
        If IsNull(rsWorkingTbl.Fields(sRec)) Then
            Grid1.Text = " "
        Else
            Grid1.Text = rsWorkingTbl.Fields(sRec)
        End If
    Next
    
    Grid1.Visible = True
    txtBox.Visible = True
    Grid1.Row = 0
    Grid1.Col = 0

End Sub





Private Sub BtnShow(sDispBtns As String)
    'Each position in the sDispBtns variable, is assigned to a
    'button
    
    'Start but hiding all the buttons
    cmdGetDataBase.Visible = False
    cmdGetTable.Visible = False
    cmdSQL.Visible = False
    cmdViewGrid.Visible = False
    cmdViewRecs.Visible = False
    cmdPrev.Visible = False
    cmdNext.Visible = False
    cmdFirst.Visible = False
    cmdLast.Visible = False
    
    'If the coresponding position for a button is set to one
    'then make the button visible
    If Mid(sDispBtns, 1, 1) = "1" Then cmdGetDataBase.Visible = True
    If Mid(sDispBtns, 2, 1) = "1" Then cmdGetTable.Visible = True
    If Mid(sDispBtns, 3, 1) = "1" Then cmdSQL.Visible = True
    If Mid(sDispBtns, 4, 1) = "1" Then cmdViewGrid.Visible = True
    If Mid(sDispBtns, 5, 1) = "1" Then cmdViewRecs.Visible = True
    If Mid(sDispBtns, 6, 1) = "1" Then cmdPrev.Visible = True
    If Mid(sDispBtns, 7, 1) = "1" Then cmdNext.Visible = True
    If Mid(sDispBtns, 8, 1) = "1" Then cmdFirst.Visible = True
    If Mid(sDispBtns, 9, 1) = "1" Then cmdLast.Visible = True
End Sub



Private Sub LoadRecSet()
    'Assing contects of the txtBox to Variable sSQL
    'if the user has chosen to run a SELECT statment
    'the contents of the txtBox is transfered to sSQL
    'becuase the actuall recordsets are created in the Main
    'module, and using a public variable simplifes the matter
    
    If Mid(txtBox, 1, 6) = "SELECT" Then
        sSQL = txtBox
    Else
        sSQL = " "
    End If
    
    'Get the Selected Table
    sList = List1.Text
    
    'Open Table
    OpenTable
    
    'Read in the Field Names
    GetRecsFlds
    
    BtnShow ("000110000")
End Sub


Private Sub Grid1_EnterCell()
    'Dispaly contents of a cell as you move through the Grid
    
    Dim sVar As Variant
    sVar = Grid1.Text
    txtBox = sVar
    txtBox.Visible = True
End Sub


Private Sub List1_Click()
    'Display message when a table has been chosen
    Me.lblDispMsg.Caption = "Select View Type"
End Sub