frmnorthwind.frm

一个三层应用程序

        .Address = txtAddress
        .City = txtCity
        .Region = txtRegion
        .PostalCode = txtPostalCode
        .Country = txtCountry
        .Phone = txtPhone
        .Fax = txtFax
        .CustomerID = txtCustomerID
        
    End With

    lngRetVal = objCustomer.Update

    If lngRetVal = 0 Then
        MsgBox "Operation Succeeded", vbInformation, "Results"
    Else
        MsgBox "Operation Failed", vbCritical, "Results"
    End If
    
    Call requery_list
End Sub

Public Sub Form_Load()
    'MsgBox "Please Note:  This project requires the SQL Stored Procedures in the attached Procs.sql " & Chr(13) & "file to be added to the Northwind database 1st", vbInformation
    Call requery_list
End Sub

Private Function Clear_Controls()
 Dim ctl As Control
 
    For Each ctl In Me.Controls
        If TypeOf ctl Is TextBox Then ctl = ""
    Next ctl
End Function

Private Function requery_list()
 Dim rs As New ADODB.Recordset
 Dim strSQL As String
 
    cboCompanyName.Clear
    
    strSQL = "SELECT CustomerID FROM customers where customerID <> ''"
    rs.Open strSQL, g_objCn
    Do While Not rs.EOF
        cboCompanyName.AddItem rs(0)
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End Function


Public Function Exec_prc_del_Customers(ByVal strCustomerID) 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(strCustomerID = vbNullString, Null, strCustomerID))
        .Execute Options:=adExecuteNoRecords
    
        Exec_prc_del_Customers = .Parameters("RETURN_VALUE")
    End With
    objCn.Close
    Set objCn = Nothing
    
    '   Added for test project
    Debug.Print Cmd2SQL(objCmd)

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

Public Function Exec_prc_ins_Customers(ByVal strCustomerID, ByVal strCompanyName, _
            ByVal strContactName, ByVal strContactTitle, _
            ByVal strAddress, ByVal strCity, ByVal strRegion, _
            ByVal strPostalCode, ByVal strCountry, ByVal strPhone, _
            ByVal strFax) 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(strCustomerID = vbNullString, Null, strCustomerID))
        .Parameters.Append .CreateParameter("CompanyName", adWChar, adParamInput, 40, IIf(strCompanyName = vbNullString, Null, strCompanyName))
        .Parameters.Append .CreateParameter("ContactName", adWChar, adParamInput, 30, IIf(strContactName = vbNullString, Null, strContactName))
        .Parameters.Append .CreateParameter("ContactTitle", adWChar, adParamInput, 30, IIf(strContactTitle = vbNullString, Null, strContactTitle))
        .Parameters.Append .CreateParameter("Address", adWChar, adParamInput, 60, IIf(strAddress = vbNullString, Null, strAddress))
        .Parameters.Append .CreateParameter("City", adWChar, adParamInput, 15, IIf(strCity = vbNullString, Null, strCity))
        .Parameters.Append .CreateParameter("Region", adWChar, adParamInput, 15, IIf(strRegion = vbNullString, Null, strRegion))
        .Parameters.Append .CreateParameter("PostalCode", adWChar, adParamInput, 10, IIf(strPostalCode = vbNullString, Null, strPostalCode))
        .Parameters.Append .CreateParameter("Country", adWChar, adParamInput, 15, IIf(strCountry = vbNullString, Null, strCountry))
        .Parameters.Append .CreateParameter("Phone", adWChar, adParamInput, 24, IIf(strPhone = vbNullString, Null, strPhone))
        .Parameters.Append .CreateParameter("Fax", adWChar, adParamInput, 24, IIf(strFax = vbNullString, Null, strFax))
        .Execute Options:=adExecuteNoRecords
    
        Exec_prc_ins_Customers = .Parameters("RETURN_VALUE")
    End With
    objCn.Close
    Set objCn = Nothing
    
    '   Added for test project
    Debug.Print Cmd2SQL(objCmd)

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

Public Function Exec_prc_upd_Customers(ByVal strCustomerID, ByVal strCompanyName, _
        ByVal strContactName, ByVal strContactTitle, _
        ByVal strAddress, ByVal strCity, ByVal strRegion, _
        ByVal strPostalCode, ByVal strCountry, ByVal strPhone, _
        ByVal strFax) 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(strCustomerID = vbNullString, Null, strCustomerID))
        .Parameters.Append .CreateParameter("CompanyName", adWChar, adParamInput, 40, IIf(strCompanyName = vbNullString, Null, strCompanyName))
        .Parameters.Append .CreateParameter("ContactName", adWChar, adParamInput, 30, IIf(strContactName = vbNullString, Null, strContactName))
        .Parameters.Append .CreateParameter("ContactTitle", adWChar, adParamInput, 30, IIf(strContactTitle = vbNullString, Null, strContactTitle))
        .Parameters.Append .CreateParameter("Address", adWChar, adParamInput, 60, IIf(strAddress = vbNullString, Null, strAddress))
        .Parameters.Append .CreateParameter("City", adWChar, adParamInput, 15, IIf(strCity = vbNullString, Null, strCity))
        .Parameters.Append .CreateParameter("Region", adWChar, adParamInput, 15, IIf(strRegion = vbNullString, Null, strRegion))
        .Parameters.Append .CreateParameter("PostalCode", adWChar, adParamInput, 10, IIf(strPostalCode = vbNullString, Null, strPostalCode))
        .Parameters.Append .CreateParameter("Country", adWChar, adParamInput, 15, IIf(strCountry = vbNullString, Null, strCountry))
        .Parameters.Append .CreateParameter("Phone", adWChar, adParamInput, 24, IIf(strPhone = vbNullString, Null, strPhone))
        .Parameters.Append .CreateParameter("Fax", adWChar, adParamInput, 24, IIf(strFax = vbNullString, Null, strFax))
        .Execute Options:=adExecuteNoRecords
    
        Exec_prc_upd_Customers = .Parameters("RETURN_VALUE")
    End With
    objCn.Close
    Set objCn = Nothing
    
    '   Added for test project
    Debug.Print Cmd2SQL(objCmd)
    
    Set objCmd = Nothing
    Exit Function
PROC_ERR:
    Exec_prc_upd_Customers = Err.Number
End Function

Public Function Exec_prc_sel_Customers_Output(ByVal strCustomerID As String, ByRef strCompanyName As String, ByRef strContactName As String, ByRef strContactTitle As String, ByRef strAddress As String, ByRef strCity As String, ByRef strRegion As String, ByRef strPostalCode As String, ByRef strCountry As String, ByRef strPhone As String, ByRef strFax As String) 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_Output"

    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, adParamInputOutput, 10, IIf(strCustomerID = vbNullString, Null, strCustomerID))
        .Parameters.Append .CreateParameter("CompanyName", adWChar, adParamInputOutput, 40, Null)
        .Parameters.Append .CreateParameter("ContactName", adWChar, adParamInputOutput, 30, Null)
        .Parameters.Append .CreateParameter("ContactTitle", adWChar, adParamInputOutput, 30, Null)
        .Parameters.Append .CreateParameter("Address", adWChar, adParamInputOutput, 60, Null)
        .Parameters.Append .CreateParameter("City", adWChar, adParamInputOutput, 15, Null)
        .Parameters.Append .CreateParameter("Region", adWChar, adParamInputOutput, 15, Null)
        .Parameters.Append .CreateParameter("PostalCode", adWChar, adParamInputOutput, 10, Null)
        .Parameters.Append .CreateParameter("Country", adWChar, adParamInputOutput, 15, Null)
        .Parameters.Append .CreateParameter("Phone", adWChar, adParamInputOutput, 24, Null)
        .Parameters.Append .CreateParameter("Fax", adWChar, adParamInputOutput, 24, Null)
    
        .Execute Options:=adExecuteNoRecords
    
        strCustomerID = RTrim(.Parameters("CustomerID"))
        strCompanyName = RTrim(.Parameters("CompanyName"))
        strContactName = RTrim(.Parameters("ContactName"))
        strContactTitle = RTrim(.Parameters("ContactTitle"))
        strAddress = RTrim(.Parameters("Address"))
        strCity = RTrim(.Parameters("City"))
        strRegion = RTrim(IIf(IsNull(.Parameters("Region")), "", .Parameters("Region")))
        strPostalCode = RTrim(.Parameters("PostalCode"))
        strCountry = RTrim(.Parameters("Country"))
        strPhone = RTrim(.Parameters("Phone"))
        strFax = RTrim(IIf(IsNull(.Parameters("Fax")), "", .Parameters("Fax")))
        Exec_prc_sel_Customers_Output = .Parameters("RETURN_VALUE")
    End With
    objCn.Close
    Set objCn = Nothing
    
    '   Added for test project
    Debug.Print Cmd2SQL(objCmd)
    
    Set objCmd = Nothing
    Exit Function
PROC_ERR:
    Exec_prc_sel_Customers_Output = Err.Number
End Function

Public Function Exec_prc_sel_Customers(ByVal 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(strCustomerID = vbNullString, Null, strCustomerID))
    End With
    With objRs
        .CursorLocation = adUseClient
        .Open objCmd, , adOpenStatic, adLockReadOnly
        Set .ActiveConnection = Nothing
    End With
    Exec_prc_sel_Customers = objCmd.Parameters("RETURN_VALUE")
    objCn.Close
    Set objCn = Nothing
    
    '   Added for test project
    Debug.Print Cmd2SQL(objCmd)

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



Private Function NullIt(ctl As Control) As Variant
    If TypeOf ctl Is ListBox Or TypeOf ctl Is ComboBox Then
        If ctl.ListIndex = -1 Then
            NullIt = Null
        Else
            NullIt = ctl.ItemData(ctl.ListIndex)
        End If
    ElseIf TypeOf ctl Is TextBox Then
        If ctl = "" Then
            NullIt = Null
        Else
            NullIt = ctl
        End If
    'Elseif ADD OTHER CONTROLS AS NECESSARY
    End If
End Function