cauthor.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cAuthor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private mConn As Connection

Public Enum cAuthorErrors
    aeInsertError = (vbObjectError + 1)
    aeUpdateError = (vbObjectError + 2)
    aeDeleteError = (vbObjectError + 3)
    aeFillError = (vbObjectError + 4)
    aeInitializeError = (vbObjectError + 5)
End Enum
    

Public Sub NewAuthor(psau_id As String, psau_lname As String _
    , psau_fname As String, psphone As String, psaddress As String _
    , pscity As String, psstate As String, pszip As String _
    , pbcontract As Boolean)
    'build insest string
    Dim sCmd As String
    sCmd = "insert authors (au_id, au_lname, au_fname , phone , address"
    sCmd = sCmd + ", city, state, zip, contract)"
    sCmd = sCmd + " values "
    sCmd = sCmd + "('" + psau_id + "'"
    sCmd = sCmd + ",'" + psau_lname + "'"
    sCmd = sCmd + ",'" + psau_fname + "'"
    sCmd = sCmd + ",'" + psphone + "'"
    sCmd = sCmd + ",'" + psaddress + "'"
    sCmd = sCmd + ",'" + pscity + "'"
    sCmd = sCmd + ",'" + psstate + "'"
    sCmd = sCmd + ",'" + pszip + "'"
    sCmd = sCmd + "," & IIf(pbcontract, 1, 0)
    sCmd = sCmd + ")"
    'use execute to do the insert
    On Error GoTo InsertError
    mConn.Execute sCmd
    
    Exit Sub
InsertError:
    Err.Raise aeInsertError, , FormatError(mConn _
        , "An error occured while inserting the author.")
End Sub
Public Sub UpdateAuthor(psau_id As String, psau_lname As String _
    , psau_fname As String, psphone As String, psaddress As String _
    , pscity As String, psstate As String, pszip As String _
    , pbcontract As Boolean)
    'build udpate string
    Dim sCmd As String
    sCmd = "update authors "
    sCmd = sCmd + " set"
    sCmd = sCmd + " au_lname = '" + psau_lname + "'"
    sCmd = sCmd + ",au_fname = '" + psau_fname + "'"
    sCmd = sCmd + ",phone = '" + psphone + "'"
    sCmd = sCmd + ",address = '" + psaddress + "'"
    sCmd = sCmd + ",city = '" + pscity + "'"
    sCmd = sCmd + ",state = '" + psstate + "'"
    sCmd = sCmd + ",zip = '" + pszip + "'"
    sCmd = sCmd + ",contract = " & IIf(pbcontract, 1, 0)
    sCmd = sCmd + " where au_id = '" + psau_id + "'"
    'use execute to do the update
    On Error GoTo UpdateError
    mConn.Execute sCmd
    
    Exit Sub
UpdateError:
    Err.Raise aeUpdateError, , FormatError(mConn _
        , "An error occured while updating the author.")
End Sub
Public Sub DeleteAuthor(psau_id As String)
    'build delete string
    Dim sCmd As String
    sCmd = "delete authors"
    sCmd = sCmd + " where au_id = '" + psau_id + "'"
    'use execute to do the delete
    On Error GoTo DeleteError:
    mConn.Execute sCmd
    
    Exit Sub
DeleteError:
    Err.Raise aeDeleteError, , FormatError(mConn _
        , "An error occured while deleting the author.")
End Sub
Public Function GetList(Optional psWhere As String) As Object
    'return a record set to the client as object so they don't
    'even need to have a reference to ADO to use this object
    Dim sCmd As String
    Dim rs As Recordset
    
    sCmd = "select * from authors"
    'if they wanted a restricted list give it to them
    If Len(psWhere) > 0 Then
        sCmd = sCmd + " where " + psWhere
    End If
    
    Set rs = New Recordset
    rs.CursorLocation = adUseClient
    On Error GoTo GetListError
    rs.Open sCmd, mConn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
    Set GetList = rs
    Exit Function
GetListError:
    Err.Raise aeFillError, , FormatError(mConn _
        , "An error occured while getting the list of authors.")
End Function

Private Sub Class_Initialize()
    Set mConn = New Connection
    'open the connection
    On Error GoTo InitializeError
    mConn.Open "Provider=SQLOLEDB.1;User ID=sa;Password=;" _
        + "Location=WINEMILLER;Database=pubs"
    
    Exit Sub
InitializeError:
    Err.Raise aeInitializeError, , FormatError(mConn _
        , "An error occured while making the database connection.")
End Sub

Private Sub Class_Terminate()
    mConn.Close
    Set mConn = Nothing
End Sub

Private Function FormatError(pConn As Connection, psAdditionalMessage _
    As String) As String
    
    'start it with any message passed in
    Dim Error As Error
    Dim sTemp As String
    If Len(psAdditionalMessage) > 0 Then
        sTemp = psAdditionalMessage + vbCrLf
    End If
    
    'spin through the errors collection and add in all those errors
    For Each Error In pConn.Errors
        sTemp = sTemp + Error.Source + " reported " & Error.Number _
            & " - " + Error.Description + vbCrLf
    Next Error
    FormatError = sTemp
End Function