nwordersws.vb

来自「wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重」· VB 代码 · 共 724 行 · 第 1/3 页

            Dim ordShipName As SqlParameter = cmdOrder.Parameters.Add("@ShipName", SqlDbType.VarChar, 40)
            Dim ordShipAddress As SqlParameter = cmdOrder.Parameters.Add("@ShipAddress", SqlDbType.VarChar, 60)
            Dim ordShipCity As SqlParameter = cmdOrder.Parameters.Add("@ShipCity", SqlDbType.VarChar, 15)
            Dim ordShipRegion As SqlParameter = cmdOrder.Parameters.Add("@ShipRegion", SqlDbType.VarChar, 15)
            Dim ordShipPostalCode As SqlParameter = cmdOrder.Parameters.Add("@ShipPostalCode", SqlDbType.VarChar, 10)
            Dim ordShipCountry As SqlParameter = cmdOrder.Parameters.Add("@ShipCountry", SqlDbType.VarChar, 15)
            Dim ordReturnValue As SqlParameter = cmdOrder.Parameters.Add("RETURN_VALUE", SqlDbType.Int)
            ordReturnValue.Direction = ParameterDirection.ReturnValue

            With objOrder
                'Assign values to Order parameters
                If Not blnNewOrder Then
                    ordOrderID.Value = .OrderID
                End If
                ordCustomerID.Value = .CustomerID
                ordEmployeeID.Value = .EmployeeID
                ordOrderDate.Value = .OrderDate
                If Mid(.RequiredDate.ToShortDateString, 1, 4) = "1/1/" Then
                    'Detects 0001-01-01... as null dateTime value
                    ordRequiredDate.Value = DBNull.Value
                Else
                    ordRequiredDate.Value = .RequiredDate
                End If
                If Mid(.ShippedDate.ToShortDateString, 1, 4) = "1/1/" Then
                    ordShippedDate.Value = DBNull.Value
                Else
                    ordShippedDate.Value = .ShippedDate
                End If
                ordShipVia.Value = .ShipVia
                If .Freight = 0 Then
                    ordFreight.Value = DBNull.Value
                Else
                    ordFreight.Value = .Freight
                End If
                ordShipName.Value = .ShipName
                ordShipAddress.Value = .ShipAddress
                ordShipCity.Value = .ShipCity
                If Len(.ShipRegion) = 0 Then
                    ordShipRegion.Value = DBNull.Value
                Else
                    ordShipRegion.Value = .ShipRegion
                End If
                If Len(.ShipPostalCode) = 0 Then
                    ordShipPostalCode.Value = DBNull.Value
                Else
                    ordShipPostalCode.Value = .ShipPostalCode
                End If
                ordShipCountry.Value = .ShipCountry
                If blnNewOrder Then
                    cmdOrder.CommandText = "ipInsertOrder"
                Else
                    cmdOrder.CommandText = "ipUpdateOrder"
                End If
            End With

            'Set up the cmdDetail command
            cmdDetail.Connection = cnnNwind
            cmdDetail.CommandType = CommandType.StoredProcedure
            cmdDetail.CommandText = "ipInsertDetail"

            'Add the Order Details parameters (delete existing items for update)
            Dim dtlOrderID As SqlParameter = cmdDetail.Parameters.Add("@OrderID", SqlDbType.Int)
            Dim dtlProductID As SqlParameter = cmdDetail.Parameters.Add("@ProductID", SqlDbType.Int)
            Dim dtlUnitPrice As SqlParameter = cmdDetail.Parameters.Add("@UnitPrice", SqlDbType.Money)
            Dim dtlQuantity As SqlParameter = cmdDetail.Parameters.Add("@Quantity", SqlDbType.SmallInt)
            Dim dtlDiscount As SqlParameter
            If blnIsDiscountDecimal Then
                'Data type was changed to Decimal
                dtlDiscount = cmdDetail.Parameters.Add("@Discount", SqlDbType.Decimal)
            Else
                'Data type is Float (Single)
                dtlDiscount = cmdDetail.Parameters.Add("@Discount", SqlDbType.Float)
            End If
            Dim dtlDelDetails As SqlParameter = cmdDetail.Parameters.Add("@DelDetails", SqlDbType.Bit)
            Dim dtlReturnValue As SqlParameter = cmdDetail.Parameters.Add("RETURN_VALUE", SqlDbType.Int)
            dtlReturnValue.Direction = ParameterDirection.ReturnValue
            Try
                'Open after processing parameters
                xactOrder = cnnNwind.BeginTransaction
                cmdOrder.Transaction = xactOrder
                cmdOrder.ExecuteNonQuery()
                intReturnValue = CInt(ordReturnValue.Value)
                If intReturnValue > 0 Then
                    cmdDetail.Transaction = xactOrder
                    blnCommit = True
                    For intCtr = 0 To UBound(objOrder.OrderDetails)
                        With objOrder.OrderDetails(intCtr)
                            If blnNewOrder Then
                                'Assign @@IDENTITY
                                dtlOrderID.Value = intReturnValue
                            Else
                                dtlOrderID.Value = .OrderID
                            End If
                            dtlProductID.Value = .ProductID
                            dtlUnitPrice.Value = .UnitPrice
                            dtlQuantity.Value = .Quantity
                            dtlDiscount.Value = .Discount
                            If blnNewOrder Then
                                dtlDelDetails.Value = 0
                            ElseIf intCtr = 0 Then
                                'Delete all order details before starting
                                dtlDelDetails.Value = 1
                            Else
                                dtlDelDetails.Value = 0
                            End If
                        End With
                        cmdDetail.ExecuteNonQuery()
                        intReturnValue = CInt(dtlReturnValue.Value)
                        If intReturnValue > 0 Then
                            blnCommit = True
                        Else
                            blnCommit = False
                            Exit For
                        End If
                    Next intCtr
                    If blnCommit Then
                        xactOrder.Commit()
                    End If
                Else
                    blnCommit = False
                    xactOrder.Rollback()
                    Dim excSOAP As New SoapException("Transaction failed or rolled back", SoapException.ClientFaultCode)
                    Throw excSOAP
                End If
            Catch excSQL As SqlClient.SqlException
                If Not xactOrder.Connection Is Nothing Then
                    If Not cmdOrder.Transaction Is Nothing Then
                        xactOrder.Rollback()
                    End If
                End If
                Dim excSOAP As New SoapException("SQLClient exception, transaction rolled back", SoapException.ClientFaultCode)
                Throw excSOAP

                Return -10
            Catch excSystem As System.Exception
                Dim excSOAP As New SoapException("System exception: " + excSystem.Message, SoapException.ClientFaultCode)
                Throw excSOAP

                Return -5
            Finally
                If Not cnnNwind Is Nothing Then
                    cnnNwind.Close()
                End If
            End Try
        End Function

        '************************************************************************
        'Dynamic SQL-based lookup methods (no parameters)
        'Get Last100Orders, GetEmployees, GetShippers, GetProducts, Get Customers
        '************************************************************************

        <WebMethod(Description:="The GetLast10Orders Web method returns " + _
        "a integer array of the last 10 OrderID values of the Orders table. " + _
        "This method is intended for filling an InfoPath drop-down list from " + _
        "a secondary data source to find the last added Order record.")> _
        Public Function GetLast10Orders() As Int32()
            Dim strSQL As String
            Dim intRow As Integer
            Dim strSoapExc As String = "Can't connect to NorthwindCS database"
            Dim intOrders(9) As Int32

            Dim cnnNWind As New SqlConnection(strReadConnect)
            strSQL = "SELECT TOP 10 OrderID FROM Orders ORDER BY OrderID DESC"
            Dim cmdOrder As New SqlCommand(strSQL, cnnNWind)
            cmdOrder.CommandType = CommandType.Text
            Dim rdrOrders As SqlDataReader
            Try
                cnnNWind.Open()
                rdrOrders = cmdOrder.ExecuteReader()
                intRow = 0
                With rdrOrders
                    strSoapExc = "Error reading OrderIDs from Orders table"
                    While .Read
                        intOrders(intRow) = .GetInt32(0)
                        intRow += 1
                    End While
                End With
                Return intOrders
            Catch ex As Exception
                Dim excSOAP As New SoapException(strSoapExc, SoapException.ClientFaultCode)
                Throw excSOAP
            Finally
                If cnnNWind.State = ConnectionState.Open Then
                    cnnNWind.Close()
                End If
            End Try
        End Function

        <WebMethod(Description:="The GetEmployees Web method returns " + _
        "an empLookup object with IDs and names of Northwind employes. " + _
        "This method is intended for filling an InfoPath drop-down list from " + _
        "a secondary data source to select valid employee ID values.")> _
        Public Function GetEmployees() As empLookup
            Dim strSQL As String
            Dim intRow As Integer
            Dim rdrOrder As SqlDataReader = Nothing
            Dim strSoapExc As String = "Can't connect to NorthwindCS database"
            Dim objEmpls As New empLookup()

            Dim cnnNWind As New SqlConnection(strReadConnect)
            strSQL = "SELECT EmployeeID, FirstName + ' ' + LastName AS FullName FROM Employees"
            Dim cmdOrder As New SqlCommand(strSQL, cnnNWind)
            cmdOrder.CommandType = CommandType.Text
            Dim rdrEmpls As SqlDataReader
            Try
                cnnNWind.Open()
                rdrEmpls = cmdOrder.ExecuteReader()
                intRow = 0
                With rdrEmpls
                    strSoapExc = "Error reading Employees table"
                    While .Read
                        Dim objEmp As New employee()
                        objEmp.emplID = .GetInt32(0)
                        objEmp.emplName = .GetString(1)
                        objEmpls.employees(intRow) = objEmp
                        intRow += 1
                    End While
                End With
                ReDim Preserve objEmpls.employees(intRow - 1)
                Return objEmpls
            Catch ex As Exception
                Dim excSOAP As New SoapException(strSoapExc, SoapException.ClientFaultCode)
                Throw excSOAP
            Finally
                If cnnNWind.State = ConnectionState.Open Then
                    cnnNWind.Close()
                End If
            End Try
        End Function

        <WebMethod(Description:="The GetShippers Web method returns " + _
        "a shipLookup object with IDs and company names of Northwind shippers. " + _
        "This method is intended for filling an InfoPath drop-down list from " + _
        "a secondary data source to select valid ShipVia ID values.")> _
        Public Function GetShippers() As shipLookup
            Dim strSQL As String
            Dim intRow As Integer
            Dim strSoapExc As String = "Can't connect to NorthwindCS database"
            Dim objShips As New shipLookup()

            Dim cnnNWind As New SqlConnection(strReadConnect)
            strSQL = "SELECT ShipperID, CompanyName FROM Shippers"