tabledata.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 5.1 Example"
   ClientHeight    =   3405
   ClientLeft      =   1470
   ClientTop       =   2610
   ClientWidth     =   4440
   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"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3405
   ScaleWidth      =   4440
   Begin VB.CommandButton cmdChangeFile 
      Caption         =   "Change &File"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   90
      TabIndex        =   8
      Top             =   2760
      Width           =   1335
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "E&xit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   3030
      TabIndex        =   7
      Top             =   2760
      Width           =   1335
   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          =   1230
      Left            =   90
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   90
      Width           =   4245
   End
   Begin MSComDlg.CommonDialog cdlTableData 
      Left            =   120
      Top             =   3510
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
      CancelError     =   -1  'True
      DefaultExt      =   "MDB"
      DialogTitle     =   "Database File"
      FileName        =   "*.MDB"
      Filter          =   "*.MDB"
   End
   Begin VB.Label lblRecords 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2190
      TabIndex        =   6
      Top             =   2250
      Width           =   1095
   End
   Begin VB.Label lblModified 
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2190
      TabIndex        =   5
      Top             =   1800
      Width           =   2145
   End
   Begin VB.Label lblCreated 
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2190
      TabIndex        =   4
      Top             =   1470
      Width           =   2145
   End
   Begin VB.Label lblTableData 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Records:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   2
      Left            =   1440
      TabIndex        =   3
      Top             =   2280
      Width           =   645
   End
   Begin VB.Label lblTableData 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Last Modified:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   1
      Left            =   1080
      TabIndex        =   2
      Top             =   1830
      Width           =   990
   End
   Begin VB.Label lblTableData 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Created:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   0
      Left            =   1470
      TabIndex        =   1
      Top             =   1500
      Width           =   600
   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 colTableData As Collection
Private Sub Form_Load()
    GetDatabase
End Sub
Private Sub GetDatabase()
    Dim dbfTableData As Database
    Dim tdfTables As TableDefs, tdfSelectedTable As TableDef
    Dim objTable As clsTableData
    Dim strDatabaseName As String

    On Error GoTo NoDatabaseError
        'Call the ShowOpen method of the CommonDialog control, so the user
        'can select a database.
        cdlTableData.ShowOpen
        On Error GoTo GetDatabaseError
            strDatabaseName = cdlTableData.filename
            Screen.MousePointer = vbHourglass
            'Open the chosen database
            Set dbfTableData = DBEngine.Workspaces(0).OpenDatabase(strDatabaseName, False, True)
            'Fetch the TableDefs collection & place in a local variable.  This
            'has the benefit of slightly faster processing
            Set tdfTables = dbfTableData.TableDefs
            'Set up the collection class we're using, so new instances of our
            'clsTableData class can be stored in it.
            Set colTableData = New Collection
            'For each TableDef in TableDefs, use the clsTableData to get
            'the needed info from the table, and place the table's name
            'and its index within the collection in the list box.
            For Each tdfSelectedTable In tdfTables
                If Left$(tdfSelectedTable.Name, 4) <> "MSys" Then
                    Set objTable = New clsTableData
                    objTable.ExtractStatusData tdfSelectedTable
                    colTableData.Add objTable
                    With lstTables
                        .AddItem objTable.Name
                        .ItemData(lstTables.NewIndex) = colTableData.Count
                    End With
                End If
            Next
            'Now that it's not needed, close the database.
            dbfTableData.Close
        On Error GoTo 0
        Screen.MousePointer = vbDefault
    On Error GoTo 0
Exit Sub

NoDatabaseError:
    'If the user didn't select a database, end the application.
    End

GetDatabaseError:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbExclamation
    End
End Sub
Private Sub lstTables_Click()
    Dim objTable As clsTableData, intPosition As Integer
    
    'Get the ItemData from the list; the index of the selected
    'clsTableData stored in our collection.
    intPosition = lstTables.ItemData(lstTables.ListIndex)
    
    'Using this index, fetch our selected instance of clsTableData.
    Set objTable = colTableData.Item(intPosition)
    
    'Read the properties of our class into the labels
    lblCreated = Format$(objTable.WhenCreated, "General Date")
    lblModified = Format$(objTable.WhenModified, "General Date")
    lblRecords = objTable.NumRecords
End Sub
Private Sub cmdChangeFile_Click()
    'Clear out the form, and flush the existing collection.
    lstTables.Clear
    lblCreated = "": lblModified = "": lblRecords = ""
    Set colTableData = Nothing
    
    'Reset our CommonDialog control, and get another database.
    cdlTableData.filename = "*.MDB"
    GetDatabase
End Sub
Private Sub cmdExit_Click()
    End
End Sub