数据库编程

开发平台：
Visual Basic

Form1.frm：源码内容
							VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   Caption         =   "获得数据库的信息"
   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         =   "打开数据库"
      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            =   120
      TabIndex        =   8
      Top             =   2760
      Width           =   1335
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "退出程序"
      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          =   840
      Left            =   90
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   480
      Width           =   4245
   End
   Begin MSComDlg.CommonDialog cdlTableData 
      Left            =   120
      Top             =   3510
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DefaultExt      =   "MDB"
      DialogTitle     =   "Database File"
      FileName        =   "*.MDB"
      Filter          =   "*.MDB"
   End
   Begin VB.Label Label1 
      Caption         =   "数据库中包含以下表："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   120
      Width           =   2295
   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         =   "记录数目:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   192
      Index           =   2
      Left            =   1440
      TabIndex        =   3
      Top             =   2280
      Width           =   612
   End
   Begin VB.Label lblTableData 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "最后修改时间:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   192
      Index           =   1
      Left            =   1080
      TabIndex        =   2
      Top             =   1836
      Width           =   900
   End
   Begin VB.Label lblTableData 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "创建时间:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   192
      Index           =   0
      Left            =   1476
      TabIndex        =   1
      Top             =   1500
      Width           =   612
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Download by http://www.codefans.net
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
        
        cdlTableData.ShowOpen
        On Error GoTo GetDatabaseError
            strDatabaseName = cdlTableData.FileName
            Screen.MousePointer = vbHourglass
            '打开选中的数据库
            Set dbfTableData = DBEngine.Workspaces(0).OpenDatabase(strDatabaseName, False, True)
            
            Set tdfTables = dbfTableData.TableDefs
            
            Set colTableData = New Collection
            
            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
            
            dbfTableData.Close
        On Error GoTo 0
        Screen.MousePointer = vbDefault
    On Error GoTo 0
Exit Sub
NoDatabaseError:
    '如果用户没有选择数据库，则退出程序。
    End
GetDatabaseError:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbExclamation
    End
End Sub
Private Sub lstTables_Click()
    Dim objTable As clsTableData, intPosition As Integer
    
    intPosition = lstTables.ItemData(lstTables.ListIndex)
    
    Set objTable = colTableData.Item(intPosition)
    
    lblCreated = Format$(objTable.WhenCreated, "General Date")
    lblModified = Format$(objTable.WhenModified, "General Date")
    lblRecords = objTable.NumRecords
End Sub
Private Sub cmdChangeFile_Click()
    
    lstTables.Clear
    lblCreated = "": lblModified = "": lblRecords = ""
    Set colTableData = Nothing
    
    cdlTableData.FileName = "*.MDB"
    GetDatabase
End Sub
Private Sub cmdExit_Click()
    End
End Sub

						