transact.frm

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

Const BIBLIO_PATH = "D:\Program Files\Microsoft Visual Studio\VB6\Biblio.MDB"

Const AUTHOR_LIST = 1
Const PUBLISHER_LIST = 2
Private blnFormIsDirty As Boolean
Private blnRefillAuthorList As Boolean
Private blnRefillPublisherList As Boolean
Private Sub cmdClose_Click()
    If blnFormIsDirty Then
        Select Case MsgBox("Do you want to save the current record?", _
        vbQuestion + vbYesNoCancel)
            Case vbYes
                If SaveRecord() = False Then Exit Sub
            Case vbNo
                End
            Case vbCancel
                Exit Sub
        End Select
    End If
    End
End Sub
Private Sub Form_Load()
    FillList AUTHOR_LIST: FillList PUBLISHER_LIST
    blnFormIsDirty = False
End Sub
Sub FillList(intListType As Integer)
    Dim cboTemp As ComboBox
    Dim dbfTemp As Database, recTemp As Recordset
    
    On Error GoTo FillListError
    
    Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
    
    Select Case intListType
        Case AUTHOR_LIST
            Set cboTemp = cboAuthor
            Set recTemp = dbfTemp.OpenRecordset("SELECT [Au_ID], [Author] FROM [Authors]")
        Case PUBLISHER_LIST
            Set cboTemp = cboPublisher
            Set recTemp = dbfTemp.OpenRecordset("SELECT [PubID], [Name] FROM [Publishers]")
    End Select
    
    cboTemp.Clear
    
    If recTemp.RecordCount Then
        recTemp.MoveFirst
        Do
            cboTemp.AddItem recTemp.Fields(1)
            cboTemp.ItemData(cboTemp.NewIndex) = recTemp.Fields(0)
            recTemp.MoveNext
        Loop Until recTemp.EOF
    End If
Exit Sub

FillListError:
    Dim strErrMsg As String
    
    strErrMsg = "Error while filling " & _
        IIf(intListType = AUTHOR_LIST, "Author", "Publisher") & " list."
    strErrMsg = strErrMsg & vbCr & Err.Number & " - " & Err.Description
    
    MsgBox strErrMsg, vbCritical
    End
End Sub
Private Sub cmdSave_Click()
    SaveRecord
End Sub

Function SaveRecord() As Boolean
    Dim lngAuthorID As Long, lngPublisherID As Long
    Dim dbfTemp As Database, recTemp As Recordset
    
    On Error GoTo SaveError
        Workspaces(0).BeginTrans
        
        If cboAuthor.ListIndex = -1 Then
            If cboAuthor.Text = "" Then Error 32767
1000        lngAuthorID = CreateAuthor(cboAuthor.Text)
            blnRefillAuthorList = True
        Else
            lngAuthorID = cboAuthor.ItemData(cboAuthor.ListIndex)
        End If
            
        If cboPublisher.ListIndex = -1 Then
            If cboPublisher.Text = "" Then Error 32766
1050        lngPublisherID = CreatePublisher(cboPublisher.Text)
            blnRefillPublisherList = True
        Else
            lngPublisherID = cboPublisher.ItemData(cboPublisher.ListIndex)
        End If
            
        If txtTitle <> "" And txtISBN <> "" Then
            Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
            
1100        Set recTemp = dbfTemp.OpenRecordset("Titles", dbOpenTable)
            With recTemp
                .AddNew
                ![PubID] = lngPublisherID
                ![ISBN] = txtISBN
                ![Title] = txtTitle
                ![Year Published] = txtYearPublished
                .Update
            End With
                
1150        Set recTemp = dbfTemp.OpenRecordset("Title Author", dbOpenTable)
            With recTemp
                .AddNew
                ![Au_ID] = lngAuthorID
                ![ISBN] = txtISBN
                .Update
            End With
        Else
            If txtTitle = "" Then Error 32765 Else Error 32764
        End If
            
        Workspaces(0).CommitTrans
        
    On Error GoTo SaveErrorNoRollback
        ClearForm
        blnFormIsDirty = False
        SaveRecord = True
    On Error GoTo 0
Exit Function

SaveError:
    Dim strErrMsg As String
    
    Workspaces(0).Rollback
    
    Select Case Err
        Case 32767
            strErrMsg = "You have not entered an author name"
        Case 32766
            strErrMsg = "You have not entered a publisher name"
        Case 32765
            strErrMsg = "You have not entered a title"
        Case 32764
            strErrMsg = "You have not entered an ISBN number"
        Case Else
            Select Case Erl
                Case 1000
                    strErrMsg = "Error " & Err.Number & " (" & Err.Description & _
                        "} encountered creating new Authors record."
                Case 1050
                    strErrMsg = "Error " & Err.Number & " (" & Err.Description & _
                        "} encountered creating new Publishers record."
                Case 1100
                    strErrMsg = "Error " & Err.Number & " (" & Err.Description & _
                        "} encountered creating new Titles record."
                Case 1150
                    strErrMsg = "Error " & Err.Number & " (" & Err.Description & _
                        "} encountered creating new Title Author record."
                Case Else
                    strErrMsg = Err.Description
            End Select
    End Select
    MsgBox strErrMsg, vbExclamation
    
    SaveRecord = False
Exit Function

SaveErrorNoRollback:
    MsgBox Err.Description, vbExclamation
Resume Next

End Function
Function CreateAuthor(strAuthorName As String) As Long
    Dim dbfTemp As Database, recTemp As Recordset
    
    Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
  
    Set recTemp = dbfTemp.OpenRecordset("Authors", dbOpenTable)
    With recTemp
        .AddNew
        ![Author] = strAuthorName
        .Update
        .Bookmark = .LastModified
    End With
    
    CreateAuthor = recTemp![Au_ID]
End Function
Function CreatePublisher(strPublisherName As String) As Long
    Dim dbfTemp As Database, recTemp As Recordset
    Dim lngLastID As Long
    
    Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
    
    Set recTemp = dbfTemp.OpenRecordset("Publishers", dbOpenTable)
    With recTemp
        .Index = "PrimaryKey"
        .MoveLast
        lngLastID = ![PubID]
        .AddNew
        ![PubID] = lngLastID + 1
        ![Name] = strPublisherName
        .Update
    End With
    
    CreatePublisher = lngLastID + 1
End Function
Sub ClearForm()

    If blnRefillAuthorList Then
        FillList AUTHOR_LIST
        blnRefillAuthorList = False
    Else
        cboAuthor.ListIndex = -1
    End If
    
    If blnRefillPublisherList Then
        FillList PUBLISHER_LIST
        blnRefillPublisherList = False
    Else
        cboPublisher.ListIndex = -1
    End If
    
    ' Clear the text boxes.
    txtTitle = ""
    txtISBN = ""
    txtYearPublished = ""
End Sub

Private Sub txtISBN_Change()
    blnFormIsDirty = True
End Sub

Private Sub txtTitle_Change()
    blnFormIsDirty = True
End Sub

Private Sub txtYearPublished_Change()
    blnFormIsDirty = True
End Sub

Private Sub cboAuthor_Click()
    If cboAuthor.ListIndex <> -1 Then blnFormIsDirty = True
End Sub

Private Sub cboAuthor_Change()
    blnFormIsDirty = True
End Sub

Private Sub cboPublisher_Change()
    blnFormIsDirty = True
End Sub

Private Sub cboPublisher_Click()
    If cboPublisher.ListIndex <> -1 Then blnFormIsDirty = True
End Sub