frmauthors.frm

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

        End If
        'no longer dealing with a new record
        mbNewRecord = False
        
        'add the new item to the list
        Dim NewItem As ListItem
        
        Set NewItem = listAuthors.ListItems.Add(, txtId.Text, _
            txtLastName.Text & ", " & txtFirstName.Text)
        NewItem.SubItems(1) = txtAddress.Text
        NewItem.SubItems(2) = txtCity.Text
        NewItem.SubItems(3) = txtState.Text
        NewItem.SubItems(4) = txtZip.Text
        
        Set listAuthors.SelectedItem = NewItem
    Else
        'try to update
        If chkExecute.Value = vbChecked Then
            'use the execute method of the connection
            sCmd = "update authors"
            sCmd = sCmd + " set "
            sCmd = sCmd + "au_id = '" + txtId.Text + "'"
            sCmd = sCmd + ",au_fname = '" + txtFirstName.Text + "'"
            sCmd = sCmd + ",au_lname = '" + txtLastName.Text + "'"
            sCmd = sCmd + ",address = '" + txtAddress.Text + "'"
            sCmd = sCmd + ",city = '" + txtCity.Text + "'"
            sCmd = sCmd + ",state = '" + txtState.Text + "'"
            sCmd = sCmd + ",zip = '" + txtZip.Text + "'"
            sCmd = sCmd + ",phone = '" + txtPhone.Text + "'"
            sCmd = sCmd + ",contract = " & _
                IIf(chkContract.Value = vbChecked, 1, 0)
            sCmd = sCmd + " where au_id = '" + msCurrentRecord + "'"
            On Error GoTo UpdateFailed:
            mConn.Execute sCmd
            On Error GoTo 0
        Else
            'use a Recordset Object to make the changes
            
            Set rs = New Recordset
            On Error GoTo UpdateFailed
            rs.Open "select * from authors where au_id = '" _
                + msCurrentRecord + "'", mConn, adOpenKeyset _
                , adLockOptimistic
            
            'only update the primary key if it's changed
            'ado acts like it's been updated even if the new
            'value is the same as the old so only set if it's
            'really changed
            If rs("au_id") <> txtId.Text Then
                rs!au_id = txtId.Text
            End If
            rs!au_fname = txtFirstName.Text
            rs!au_lname = txtLastName.Text
            rs!address = txtAddress.Text
            rs!city = txtCity.Text
            rs!State = txtState.Text
            rs!zip = txtZip.Text
            rs!phone = txtPhone.Text
            rs!contract = (chkContract.Value = vbChecked)
            rs.Update
            On Error GoTo 0
            
            rs.Close
            Set rs = Nothing
        End If
        
        'update the item in the list
        Dim OldItem As ListItem
        Set OldItem = listAuthors.ListItems.Item(msCurrentRecord)
        OldItem.Key = txtId.Text
        OldItem.Text = txtLastName.Text & ", " & txtFirstName.Text
        OldItem.SubItems(1) = txtAddress.Text
        OldItem.SubItems(2) = txtCity.Text
        OldItem.SubItems(3) = txtState.Text
        OldItem.SubItems(4) = txtZip.Text
    End If
    'no longer need save
    mbNeedSave = False
    cmdUpdate.Enabled = False
    cmdDelete.Enabled = True
    UpdateRecord = True
UpdateComplete:
    Exit Function
UpdateFailed:
    ShowADOError
    GoTo UpdateComplete
End Function

Private Sub RecordChanged()
    mbNeedSave = True
    cmdUpdate.Enabled = True
End Sub
Private Sub chkContract_Click()
    RecordChanged
End Sub

Private Sub cmdDelete_Click()
    If chkExecute.Value = vbChecked Then
        Dim sCmd As String
        sCmd = "delete from authors where au_id = '" _
            + msCurrentRecord + "'"
        On Error GoTo DeleteFailed
        mConn.Execute sCmd
        On Error GoTo 0
    Else
        Dim rs As Recordset
        
        'now open the recordset
        Set rs = New Recordset
        On Error GoTo DeleteFailed
        rs.Open "select * from authors where au_id = '" _
            + msCurrentRecord + "'", mConn, adOpenKeyset, adLockOptimistic
        Do Until rs.EOF
            rs.Delete
            rs.MoveNext
        Loop
        On Error GoTo 0
    End If
    'remove the item from the list
    listAuthors.ListItems.Remove msCurrentRecord
    mbNeedSave = False
    cmdUpdate.Enabled = False
    listAuthors_ItemClick listAuthors.SelectedItem
DeleteComplete:
    Exit Sub
DeleteFailed:
    ShowADOError
    GoTo DeleteComplete
End Sub

Private Sub cmdNew_Click()
    'clear screen
    txtId.Text = ""
    txtFirstName.Text = ""
    txtLastName.Text = ""
    txtAddress.Text = ""
    txtCity.Text = ""
    txtState.Text = ""
    txtZip.Text = ""
    txtPhone.Text = ""
    chkContract.Value = vbChecked
    'set flags
    mbNewRecord = True
    mbNeedSave = True
    'nothing to delete
    cmdDelete.Enabled = False
    'no record selected
    Set listAuthors.SelectedItem = Nothing
    'start the user off in the right place
    txtId.SetFocus
End Sub

Private Sub cmdUpdate_Click()
    UpdateRecord
End Sub

Private Sub Form_Load()
    Dim rs As Recordset
    Dim NewItem As ListItem
    
    'open the connection
    Set mConn = New Connection
    mConn.Open "Provider=SQLOLEDB.1;User ID=sa;Password=password;" _
        + "Location=WINEMILLER;Database=pubs"
        
    'could have also just specified an ODBC DSN like below
    'mConnOpen "DSN=pubs"
    
    'now open the recordset
    Set rs = New Recordset
    rs.Open "authors", mConn, adOpenForwardOnly, adLockReadOnly
    Do Until rs.EOF
        Set NewItem = listAuthors.ListItems.Add(, rs("au_id"), _
            rs("au_lname") & ", " & rs("au_fname"))
        NewItem.SubItems(1) = rs("address")
        NewItem.SubItems(2) = rs("city")
        NewItem.SubItems(3) = rs("state")
        NewItem.SubItems(4) = rs("zip")
        rs.MoveNext
    Loop
    'close and clean up
    rs.Close
    Set rs = Nothing
    
    'set the first item
    listAuthors_ItemClick listAuthors.ListItems(1)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mConn.Close
    Set mConn = Nothing
End Sub


Private Sub listAuthors_ItemClick(ByVal Item As ComctlLib.ListItem)
    Dim rs As Recordset
    Set rs = New Recordset
    If mbNeedSave Then
        If Not UpdateRecord() Then
            Set listAuthors.SelectedItem = _
                listAuthors.ListItems.Item(msCurrentRecord)
            Exit Sub
        End If
    End If
    
    'now open the recordset
    Set rs = New Recordset
    rs.Open "select * from authors where au_id = '" + Item.Key + "'" _
        , mConn, adOpenForwardOnly, adLockReadOnly
    Do Until rs.EOF
        'update the listview in case it's changed
        Item.Text = rs("au_lname") & ", " & rs("au_fname")
        Item.SubItems(1) = rs("address")
        Item.SubItems(2) = rs("city")
        Item.SubItems(3) = rs("state")
        Item.SubItems(4) = rs("zip")
        'fill the edit controls
        txtId.Text = rs("au_id")
        txtFirstName.Text = rs("au_fname")
        txtLastName.Text = rs("au_lname")
        txtAddress.Text = rs("address")
        txtCity.Text = rs("city")
        txtState.Text = rs("state")
        txtZip.Text = rs("zip")
        txtPhone.Text = rs("phone")
        chkContract.Value = IIf(rs("contract"), vbChecked, vbUnchecked)
        
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    mbNeedSave = False
    cmdUpdate.Enabled = False
    cmdDelete.Enabled = True
    msCurrentRecord = txtId.Text
    
End Sub
Private Sub txtAddress_Change()
    RecordChanged
End Sub

Private Sub txtCity_Change()
    RecordChanged
End Sub

Private Sub txtFirstName_Change()
    RecordChanged
End Sub

Private Sub txtId_Change()
    RecordChanged
End Sub

Private Sub txtLastName_Change()
    RecordChanged
End Sub

Private Sub txtPhone_Change()
    RecordChanged
End Sub

Private Sub txtState_Change()
    RecordChanged
End Sub

Private Sub txtZip_Change()
    RecordChanged
End Sub
Private Sub ShowADOError()
    'spin through the errors collection and
    'display the constructed error message
    Dim ADOError As Error
    Dim sError As String
    For Each ADOError In mConn.Errors
        sError = sError & ADOError.Number & " - " & ADOError.Description _
            + vbCrLf
    Next ADOError
    MsgBox sError
End Sub