update.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 3.11 Example"
   ClientHeight    =   2310
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   5520
   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     =   2310
   ScaleWidth      =   5520
   Begin VB.CommandButton cmdClose 
      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          =   495
      Left            =   4200
      TabIndex        =   3
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdRestore 
      Caption         =   "&Restore"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1560
      TabIndex        =   2
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "&Update"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   1680
      Width           =   1215
   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          =   1425
      Left            =   90
      TabIndex        =   0
      Top             =   120
      Width           =   5325
   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 Const BIBLIO_PATH = "D:\Program Files\Microsoft Visual Studio\VB6\Biblio.MDB"
Private dbfBiblio As Database
Private Sub cmdUpdate_Click()
    Dim strSQL As String
    
    On Error GoTo UpdateError
        'Build the UPDATE statement.
        strSQL = "UPDATE Publishers " & _
            "SET City = 'Indianapolis', Address = '201 W. 103rd St.', " & _
            "Zip = '46290' " & _
            "WHERE ([City] = 'Carmel') AND (Address LIKE '*11711*College*')"
        
        'Execute the update query.
        dbfBiblio.Execute strSQL
    
        ListRecords "Indianapolis"
    On Error GoTo 0
Exit Sub

UpdateError:
    MsgBox Err.Description, vbExclamation
Exit Sub
End Sub

Private Sub cmdRestore_Click()
    Dim strSQL As String

    On Error GoTo RestoreError
        'Build the UPDATE statement.
        strSQL = "UPDATE Publishers " & _
            "SET City = 'Carmel', Address = '11711 N. College Ave.', " & _
            "Zip = '46032' " & _
            " WHERE ([City] = 'Indianapolis') AND (Address = '201 W. 103rd St.')"
        
        'Execute the update query.
        dbfBiblio.Execute strSQL
    
        ListRecords "Carmel"
    On Error GoTo 0
Exit Sub

RestoreError:
    MsgBox Error$, vbExclamation
Exit Sub
End Sub

Private Sub ListRecords(strCity As String)
    Dim recSelect As Recordset
    Dim strSQL As String, strAddress As String
    
    On Error GoTo ListError
        ' Set the correct street address based on the city name.
        strAddress = IIf(strCity = "Indianapolis", "201 W. 103rd St.", _
            "11711 N. College Ave.")
    
        ' Create the recordset for the list box.
        strSQL = "SELECT [Company Name], [Address], [City], [State], [Zip] " & _
            "FROM Publishers " & _
            "WHERE [City] = '" & strCity & "'" & "AND [Address] = '" & strAddress & "'"
            
        'Construct the recordset.
        Set recSelect = dbfBiblio.OpenRecordset(strSQL, dbOpenSnapshot)
        
        'Clear the list box
        lstData.Clear
        
        'Show each record in the list box.
        If recSelect.RecordCount > 0 Then
            recSelect.MoveFirst
            Do
                lstData.AddItem Left$(recSelect![Company Name], 10) _
                    & ", " & recSelect![Address] & ", " & recSelect![City] _
                    & ", " & recSelect![State] & " " & recSelect![Zip]
                recSelect.MoveNext
            Loop While Not recSelect.EOF
        End If
    On Error GoTo 0
Exit Sub

ListError:
    MsgBox Err.Description, vbExclamation
Exit Sub
End Sub

Private Sub cmdClose_Click()
    End
End Sub

Private Sub Form_Load()
    Set dbfBiblio = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
End Sub