tablist.frm

VB6数据库开发指南》的配套源程序

VERSION 5.00
Begin VB.Form frmTableList 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Chapter 3.12 Example - Table List"
   ClientHeight    =   3015
   ClientLeft      =   1605
   ClientTop       =   1560
   ClientWidth     =   3735
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3015
   ScaleWidth      =   3735
   Begin VB.CommandButton cmdDelete 
      Caption         =   "&Delete"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   120
      TabIndex        =   2
      Top             =   2280
      Width           =   1275
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2310
      TabIndex        =   1
      Top             =   2280
      Width           =   1275
   End
   Begin VB.ListBox lstTables 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2010
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   120
      Width           =   3465
   End
End
Attribute VB_Name = "frmTableList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const BIBLIO_PATH = "D:\Program Files\Microsoft Visual Studio\VB6\Biblio.MDB"

Private Sub Form_Load()
    ' Fill the list box with the current non-system tables in BIBLIO.MDB.
    ListTables
End Sub

Private Sub ListTables()
    Dim dbfBiblio As Database, tdfTableList As TableDef

    On Error GoTo ListError
        Screen.MousePointer = vbHourglass
        'Clear the list box, then open the database.
        lstTables.Clear
        Set dbfBiblio = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
        ' Cycle through the table definitions in BIBLIO_PATH.
        ' If the table is a system table (name begins with MSys), ignore it.
        ' Otherwise, add it to the list.
        For Each tdfTableList In dbfBiblio.TableDefs
            If Left$(tdfTableList.Name, 4) <> "MSys" Then lstTables.AddItem tdfTableList.Name
        Next
    
        Screen.MousePointer = vbDefault
    On Error GoTo 0
Exit Sub

ListError:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbExclamation
    Unload frmTableList
Exit Sub
End Sub

Private Sub cmdDelete_Click()
    Dim dbfBiblio As Database

    On Error GoTo DeleteError
        Screen.MousePointer = vbHourglass
        'If a table is selected, then continue
        If lstTables.ListIndex > -1 Then
            'Confirm that the table has no records
            If TableIsEmpty() Then
                ' Delete the selected table from BIBLIO_PATH.
                Set dbfBiblio = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
                dbfBiblio.Execute ("DROP TABLE [" & lstTables.Text & "]")
                
                ' Display the modified list of tables.
                ListTables
                Screen.MousePointer = vbDefault
            Else
                'The table has records, so inform the user.
                Screen.MousePointer = vbDefault
                MsgBox lstTables.Text & " is not empty.", vbExclamation
            End If
        Else
            'No table has been chosen, so inform the user.
            Screen.MousePointer = vbDefault
            MsgBox "You have not selected a table to delete.", vbExclamation
        End If
    On Error GoTo 0
Exit Sub

DeleteError:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbExclamation
    Unload frmTableList
Exit Sub

End Sub

Function TableIsEmpty() As Boolean
    Dim dbfBiblio As Database, tdfTableList As TableDef
    
    On Error GoTo TableIsEmptyError
        Set dbfBiblio = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
        
        ' Cycle through the table definitions in BIBLIO_PATH.
        ' When the table currently selected in lstTables is found, check to
        ' see whether it has records. If it does not, return True; otherwise,
        ' return False.
        For Each tdfTableList In dbfBiblio.TableDefs
            If tdfTableList.Name = lstTables.Text Then
                TableIsEmpty = IIf(tdfTableList.RecordCount = 0, True, False)
                Exit For
            End If
        Next
    On Error GoTo 0
Exit Function

TableIsEmptyError:
    MsgBox Err.Description, vbExclamation
    Unload frmTableList
Exit Function

End Function

Private Sub cmdClose_Click()
    Unload frmTableList
End Sub