append.frm

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

VERSION 5.00
Begin VB.Form frmMain 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 3.13 Example"
   ClientHeight    =   4110
   ClientLeft      =   2025
   ClientTop       =   1560
   ClientWidth     =   6720
   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     =   4110
   ScaleWidth      =   6720
   Begin VB.CommandButton cmdDeleteRecords 
      Caption         =   "&Delete 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          =   615
      Left            =   4920
      TabIndex        =   5
      Top             =   1680
      Width           =   1635
   End
   Begin VB.ListBox lstData 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3765
      Left            =   150
      Sorted          =   -1  'True
      TabIndex        =   4
      Top             =   180
      Width           =   4575
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      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            =   4920
      TabIndex        =   3
      Top             =   3360
      Width           =   1635
   End
   Begin VB.CommandButton cmdDropTable 
      Caption         =   "D&rop Table"
      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            =   4920
      TabIndex        =   2
      Top             =   2430
      Width           =   1635
   End
   Begin VB.CommandButton cmdAppendRecords 
      Caption         =   "&Append 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          =   615
      Left            =   4920
      TabIndex        =   1
      Top             =   930
      Width           =   1635
   End
   Begin VB.CommandButton cmdCreateTable 
      Caption         =   "Create &Table"
      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            =   4920
      TabIndex        =   0
      Top             =   180
      Width           =   1635
   End
End
Attribute VB_Name = "frmMain"
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 strPublisherToDelete As String
Private dbfBiblio As Database

Private Sub Form_Load()
    Dim tdfTable As TableDef
    Dim blnTableFound As Boolean

    On Error GoTo LoadError
        blnTableFound = False
        
        'Open the database.
        Set dbfBiblio = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
        'Iterate through the TableDefs collection.  If the table "Publisher Titles"
        'is found, configure the form's buttons appropriately.
        For Each tdfTable In dbfBiblio.TableDefs
            If tdfTable.Name = "Publisher Titles" Then
                blnTableFound = True
                cmdDropTable.Enabled = True
                cmdCreateTable.Enabled = False
    
                If tdfTable.RecordCount > 0 Then
                    cmdDeleteRecords.Enabled = True
                    cmdAppendRecords.Enabled = False
                    FillList
                Else
                    cmdDeleteRecords.Enabled = False
                    cmdAppendRecords.Enabled = True
                End If
                Exit For
            End If
        Next
    
        'If the table is not found, configure the form's buttons appropriately.
        If blnTableFound = False Then
            cmdDropTable.Enabled = False
            cmdCreateTable.Enabled = True
            cmdAppendRecords.Enabled = False
            cmdDeleteRecords.Enabled = False
        End If
    On Error GoTo 0
Exit Sub

LoadError:
    MsgBox Err.Description, vbExclamation
    Unload Me
Exit Sub

End Sub

Sub FillList()
    Dim recSelect As Recordset
    Dim strSQL As String

    On Error GoTo FillListError
        'Clear the list box.
        lstData.Clear
        'Get all the records from the Publisher Titles table.
        Set recSelect = dbfBiblio.OpenRecordset("SELECT * FROM [Publisher Titles]", _
            dbOpenSnapshot)
    
        'Put the records into the list box.
        If recSelect.RecordCount > 0 Then
            recSelect.MoveFirst
            Do Until recSelect.EOF
                lstData.AddItem recSelect![Name] & ": " & recSelect![Title]
                recSelect.MoveNext
            Loop
        End If
    On Error GoTo 0
Exit Sub

FillListError:
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub

Private Sub cmdCreateTable_Click()
    Dim strSQL As String
    
    On Error GoTo CreateTableError
        'Build the CREATE TABLE statement.
        strSQL = "CREATE TABLE [Publisher Titles] " & _
            "([Name] TEXT, [Title] TEXT)"
        'Execute the statement.  Since it's an action query,
        'you don't use the OpenRecordset command.  It would
        'fail, since an action query does not return a recordset.
        dbfBiblio.Execute (strSQL)
        
        'Configure the form's buttons appropriately.
        cmdCreateTable.Enabled = False
        cmdDropTable.Enabled = True
        cmdAppendRecords.Enabled = True
    On Error GoTo 0
Exit Sub

CreateTableError:
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub

Private Sub cmdDropTable_Click()
    Dim dbName As String

    On Error GoTo DropTableError
        'Build & execute the DROP TABLE statement.
        dbfBiblio.Execute ("DROP TABLE [Publisher Titles]")
        
        'Configure the form's buttons appropriately.
        cmdDropTable.Enabled = False
        cmdCreateTable.Enabled = True
        cmdAppendRecords.Enabled = False
        cmdDeleteRecords.Enabled = False
    
        'Clear the list box.
        lstData.Clear
    On Error GoTo 0
Exit Sub

DropTableError:
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub

Private Sub cmdAppendRecords_Click()
    Dim strSQL As String

    On Error GoTo AppendRecordsError
        Screen.MousePointer = vbHourglass
        'Build the INSERT INTO statement
        strSQL = "INSERT INTO [Publisher Titles] ( [Name], Title ) " & _
            "SELECT Publishers.Name, Titles.Title " & _
            "FROM Publishers INNER JOIN Titles " & _
            "ON Publishers.PubID = Titles.PubID"

        'Execute the statement.
        dbfBiblio.Execute (strSQL)

        'Fill the list box via the FillList subroutine.
        FillList

        'Configure the form's buttons appropriately.
        cmdDeleteRecords.Enabled = True
        cmdAppendRecords.Enabled = False
    
        Screen.MousePointer = vbDefault
    On Error GoTo 0
Exit Sub

AppendRecordsError:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub

Private Sub cmdDeleteRecords_Click()
    Dim strSQL As String
    
    On Error GoTo DeleteRecordsError

    'Use the GetPublisher function on frmSelectPublisher to return
    'a publisher to delete.
    strPublisherToDelete = frmSelectPublisher.GetPublisher
    'If one is selected, then delete it.
    If strPublisherToDelete <> "" Then
        'Build the DELETE statement.
        strSQL = "DELETE FROM [Publisher Titles]"
        'If the publisher to delete isn't the * wildcard, then
        'modify the SQL to choose the selected publisher(s).
        If strPublisherToDelete <> "*" Then
            strSQL = strSQL & " WHERE [Publisher Titles].[Name] = " & _
                """" & strPublisherToDelete & """"
        End If

        'Execute the statement.
        dbfBiblio.Execute (strSQL)

        'Fill the list box.
        FillList
    End If

    cmdAppendRecords.Enabled = (lstData.ListCount = 0)
    cmdDeleteRecords.Enabled = (lstData.ListCount > 0)
Exit Sub

DeleteRecordsError:
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub

Private Sub cmdClose_Click()
    End
End Sub