customers.cls

一个三层应用程序

   If m_intStatus = ltINSERT Then
       lngRetVal = Exec_prc_ins_Customers()
   ElseIf m_intStatus = ltUPDATE Then
       lngRetVal = Exec_prc_upd_Customers()
   Else
       lngRetVal = Exec_prc_del_Customers()
   End If

    If lngRetVal <> 0 Then
        '   An error occurred;
        GoTo PROC_EXIT
    End If

    '   A new record that has been Inserted becomes and existing record
    '   that will be Updtated next time;
    If m_intStatus = ltINSERT Then m_intStatus = ltUPDATE

PROC_EXIT:
    Update = lngRetVal '  Set the return code to the return code from the txn object method and exit the function;
    Exit Function
PROC_ERR:
    m_strErrDesc = "Procedure: clsCustomers.Find Number = " & Err.Number & " Description = " & Err.Description & " Line = " & Erl
    lngRetVal = Err.Number
End Function

Public Function Delete() As Long
 Dim lngRetVal As Long

    m_intStatus = ltDELETE
    lngRetVal = Update

    Delete = lngRetVal
End Function

'   GENERIC PROPERTY VARIABLES;

Public Property Get ClassID() As String
    ClassID = m_strCLASS_ID
End Property

'   IsDirty;
Public Property Get IsDirty() As Boolean
    IsDirty = m_bolIsDirty
End Property

'   Status;
Public Property Get Status() As Integer
    Status = m_intStatus
End Property

'   Error Description;
Public Property Get ErrorDesc() As String
    ErrorDesc = m_strErrDesc
End Property

'   Defaults;
Private Sub Class_Initialize()
    m_intStatus = ltINSERT
End Sub

Private Function HasVarChanged(val1 As Variant, val2 As Variant) As Boolean
    HasVarChanged = True
    '   If either of the values is a NULL check to make sure that they are NOT
    '   both NULLs  In this case the comparison would result in NULL and not =;
    If IsNull(val1) Or IsNull(val2) Then
        If IsNull(val1) And IsNull(val2) Then
            HasVarChanged = False
            Exit Function
        End If
    End If

    If val1 = val2 Then
        HasVarChanged = False
    End If
End Function

Private Function Exec_prc_del_Customers() As Long
 Dim strSQL As String
 Dim objCmd As ADODB.Command
 Dim objCn  As ADODB.Connection

        On Error GoTo PROC_ERR
        Set objCmd = New ADODB.Command
        Set objCn = New ADODB.Connection
        strSQL = "prc_del_Customers"

        objCn.Open g_strConnectionString
        With objCmd
                .CommandText = strSQL
                .CommandType = adCmdStoredProc
                Set .ActiveConnection = objCn

                .Parameters.Append .CreateParameter("RETURN_VALUE", adInteger, adParamReturnValue, 0)
                .Parameters.Append .CreateParameter("CustomerID", adVarChar, adParamInput, 10, IIf(m_strCustomerID = vbNullString, Null, m_strCustomerID))
                .Execute Options:=adExecuteNoRecords
        
                Exec_prc_del_Customers = .Parameters("RETURN_VALUE")
        End With
        objCn.Close
        Set objCn = Nothing

        Set objCmd = Nothing
        Exit Function
PROC_ERR:
        Exec_prc_del_Customers = Err.Number
        m_strErrDesc = Err.Description
End Function

Private Function Exec_prc_ins_Customers() As Long
 Dim strSQL As String
 Dim objCmd As ADODB.Command
 Dim objCn  As ADODB.Connection

        On Error GoTo PROC_ERR
        Set objCmd = New ADODB.Command
        Set objCn = New ADODB.Connection
        strSQL = "prc_ins_Customers"

        objCn.Open g_strConnectionString
        With objCmd
                .CommandText = strSQL
                .CommandType = adCmdStoredProc
                Set .ActiveConnection = objCn

                .Parameters.Append .CreateParameter("RETURN_VALUE", adInteger, adParamReturnValue, 0)
                .Parameters.Append .CreateParameter("CustomerID", adVarChar, adParamInput, 10, IIf(m_strCustomerID = vbNullString, Null, m_strCustomerID))
                .Parameters.Append .CreateParameter("CompanyName", adWChar, adParamInput, 40, IIf(m_strCompanyName = vbNullString, Null, m_strCompanyName))
                .Parameters.Append .CreateParameter("ContactName", adWChar, adParamInput, 30, m_varContactName)
                .Parameters.Append .CreateParameter("ContactTitle", adWChar, adParamInput, 30, m_varContactTitle)
                .Parameters.Append .CreateParameter("Address", adWChar, adParamInput, 60, m_varAddress)
                .Parameters.Append .CreateParameter("City", adWChar, adParamInput, 15, m_varCity)
                .Parameters.Append .CreateParameter("Region", adWChar, adParamInput, 15, m_varRegion)
                .Parameters.Append .CreateParameter("PostalCode", adWChar, adParamInput, 10, m_varPostalCode)
                .Parameters.Append .CreateParameter("Country", adWChar, adParamInput, 15, m_varCountry)
                .Parameters.Append .CreateParameter("Phone", adWChar, adParamInput, 24, m_varPhone)
                .Parameters.Append .CreateParameter("Fax", adWChar, adParamInput, 24, m_varFax)
                .Execute Options:=adExecuteNoRecords
        
                Exec_prc_ins_Customers = .Parameters("RETURN_VALUE")
        End With
        objCn.Close
        Set objCn = Nothing

        Set objCmd = Nothing
        Exit Function
PROC_ERR:
        Exec_prc_ins_Customers = Err.Number
        m_strErrDesc = Err.Description
End Function

Private Function Exec_prc_upd_Customers() As Long
 Dim strSQL As String
 Dim objCmd As ADODB.Command
 Dim objCn  As ADODB.Connection

        On Error GoTo PROC_ERR
        Set objCmd = New ADODB.Command
        Set objCn = New ADODB.Connection
        strSQL = "prc_upd_Customers"

        objCn.Open g_strConnectionString
        With objCmd
                .CommandText = strSQL
                .CommandType = adCmdStoredProc
                Set .ActiveConnection = objCn

                .Parameters.Append .CreateParameter("RETURN_VALUE", adInteger, adParamReturnValue, 0)
                .Parameters.Append .CreateParameter("CustomerID", adVarChar, adParamInput, 10, IIf(m_strCustomerID = vbNullString, Null, m_strCustomerID))
                .Parameters.Append .CreateParameter("CompanyName", adWChar, adParamInput, 40, IIf(m_strCompanyName = vbNullString, Null, m_strCompanyName))
                .Parameters.Append .CreateParameter("ContactName", adWChar, adParamInput, 30, m_varContactName)
                .Parameters.Append .CreateParameter("ContactTitle", adWChar, adParamInput, 30, m_varContactTitle)
                .Parameters.Append .CreateParameter("Address", adWChar, adParamInput, 60, m_varAddress)
                .Parameters.Append .CreateParameter("City", adWChar, adParamInput, 15, m_varCity)
                .Parameters.Append .CreateParameter("Region", adWChar, adParamInput, 15, m_varRegion)
                .Parameters.Append .CreateParameter("PostalCode", adWChar, adParamInput, 10, m_varPostalCode)
                .Parameters.Append .CreateParameter("Country", adWChar, adParamInput, 15, m_varCountry)
                .Parameters.Append .CreateParameter("Phone", adWChar, adParamInput, 24, m_varPhone)
                .Parameters.Append .CreateParameter("Fax", adWChar, adParamInput, 24, m_varFax)
                .Execute Options:=adExecuteNoRecords
        
                Exec_prc_upd_Customers = .Parameters("RETURN_VALUE")
        End With
        objCn.Close
        Set objCn = Nothing

        Set objCmd = Nothing
        Exit Function
PROC_ERR:
        Exec_prc_upd_Customers = Err.Number
        m_strErrDesc = Err.Description
End Function

Private Function Exec_prc_sel_Customers(ByVal m_strCustomerID As String, ByRef objRs As Recordset) As Long
 Dim strSQL As String
 Dim objCmd As ADODB.Command
 Dim objCn  As ADODB.Connection

        On Error GoTo PROC_ERR
        Set objCmd = New ADODB.Command
        Set objCn = New ADODB.Connection
        strSQL = "prc_sel_Customers"

        objCn.Open g_strConnectionString
        With objCmd
                .CommandText = strSQL
                .CommandType = adCmdStoredProc
                Set .ActiveConnection = objCn

                .Parameters.Append .CreateParameter("RETURN_VALUE", adInteger, adParamReturnValue, 0)
                .Parameters.Append .CreateParameter("CustomerID", adVarChar, adParamInput, 10, IIf(m_strCustomerID = vbNullString, Null, m_strCustomerID))
        End With
        With objRs
                .CursorLocation = adUseClient
                .Open objCmd, , adOpenDynamic, adLockReadOnly
                Set .ActiveConnection = Nothing
        End With
        Exec_prc_sel_Customers = objCmd.Parameters("RETURN_VALUE")
        objCn.Close
        Set objCn = Nothing

        Set objCmd = Nothing
        Exit Function
PROC_ERR:
        Exec_prc_sel_Customers = Err.Number
        m_strErrDesc = Err.Description
End Function