storedprocedures.vb

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

        Dim decFreight As Decimal = sdrOrder.GetDecimal(21)
        sdrOrder.Close()

        'Add line items with full product descriptions
        Dim intItem As Integer
        Dim intItems As Integer
        Dim decAmount As Decimal
        strSQL = "SELECT d.ProductID, p.ProductName, p.QuantityPerUnit, " + _
        "d.Quantity, d.UnitPrice, d.Discount " + _
        "FROM [Order Details] AS d, Products AS p " + _
        "WHERE d.OrderID = " + intOrderID.ToString + _
        " AND p.ProductID = d.ProductID"
        Dim sdrItem As SqlDataReader = Nothing
        Try
            With cmNwind
                .CommandText = strSQL
                sdrItem = .ExecuteReader
            End With
        Catch exc As Exception
            sdrItem.Close()
            cnNwind.Close()
            Throw New Exception("Exception executing line item query.")
            Return
        End Try
        With sdrItem
            If .HasRows Then
                While .Read
                    intItem += 1
                    xwOrder.WriteStartElement("nwso", "LineItem", strNwSo)
                    xwOrder.WriteAttributeString("nwso", "OrderID", strNwSo, intOrderID.ToString)
                    xwOrder.WriteAttributeString("nwso", "ProductID", strNwSo, .GetInt32(0).ToString)
                    xwOrder.WriteAttributeString("nwso", "ItemID", strNwSo, intItem.ToString)
                    xwOrder.WriteElementString("nwso", "ItemNumber", strNwSo, intItem.ToString)
                    xwOrder.WriteElementString("nwso", "Ordered", strNwSo, .GetInt16(3).ToString)
                    xwOrder.WriteElementString("nwso", "SKU", strNwSo, .GetInt32(0).ToString)
                    xwOrder.WriteElementString("nwso", "Product", strNwSo, .GetString(1))
                    xwOrder.WriteElementString("nwso", "Package", strNwSo, .GetString(2))
                    xwOrder.WriteElementString("nwso", "ListPrice", strNwSo, .GetDecimal(4).ToString("#0.00"))
                    'Following accommodates real and decimal data types
                    Dim decDisc As Decimal = CDec(.GetValue(5))
                    xwOrder.WriteElementString("nwso", "Discount", strNwSo, (100 * CDec(.GetValue(5))).ToString("#0.0"))
                    Dim decExt As Decimal = .GetInt16(3) * .GetDecimal(4) * (1 - decDisc)
                    xwOrder.WriteElementString("nwso", "Extended", strNwSo, (decExt.ToString("0.00")))
                    xwOrder.WriteEndElement() 'LineItem
                    intItems += CInt(.GetInt16(3))
                    decAmount += decExt
                End While
                .Close()
                cnNwind.Close()
            Else
                .Close()
                cnNwind.Close()
                Throw New Exception("No rows returned by line item query.")
                Return
            End If
        End With
        With xwOrder
            .WriteEndElement() 'LineItems
            .WriteStartElement("nwso", "Summary", strNwSo)
            .WriteElementString("nwso", "ItemsOrdered", strNwSo, intItems.ToString)
            .WriteElementString("nwso", "Subtotal", strNwSo, decAmount.ToString("0.00"))
            .WriteElementString("nwso", "EstimatedFreight", strNwSo, decFreight.ToString("0.00"))
            Dim decTotal As Decimal = decAmount + decFreight
            .WriteElementString("nwso", "Total", strNwSo, decTotal.ToString("0.00"))
            .WriteEndElement() 'Summary
            .WriteEndElement() 'SalesOrder
            .Flush()
            .Close()
        End With
        Dim strOrderXML As String = Nothing
        If File.Exists(strFile) Then
            strOrderXML = File.ReadAllText(strFile, Encoding.Unicode)
            Dim intCols As Integer = (strOrderXML.Length \ 4000)
            Dim intCol As Integer
            Dim strColName As String = "SalesOrderXML"
            Try
                'spOrder.Send(strOrderXML) doesn't work, because order 11077 
                'with namespaces is 13,017 chars and SqlPipe is limited to 4,000 chars
                'Create multiple 4,000-char columns when necessary (4 for 11077)
                Dim mdCust(intCols) As SqlMetaData
                For intCol = 0 To intCols
                    mdCust(intCol) = New SqlMetaData(strColName + intCol.ToString, SqlDbType.NVarChar, 4000)
                Next intCol
                Dim sdrCust As New SqlDataRecord(mdCust)
                For intCol = 0 To intCols
                    If strOrderXML.Length <= 4000 Then
                        sdrCust.SetString(intCol, strOrderXML)
                    Else
                        sdrCust.SetString(intCol, strOrderXML.Substring(0, 4000))
                        strOrderXML = strOrderXML.Substring(4000)
                    End If
                Next intCol
                spOrder.Send(sdrCust)
            Catch exc As Exception
                Throw New Exception(exc.Message)
            End Try
        Else
            Throw New Exception("Failed to create '" + strFile + "' file.")
        End If
    End Sub

    <SqlProcedure()> _
      Public Shared Sub csp_LinearRegression(ByVal ProductID As SqlInt32, ByVal LastMonth As SqlDateTime, ByVal Months As SqlByte, ByVal UseSalesOrders As SqlByte)
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmNwind As New SqlCommand
        Dim strSQL As String = Nothing
        Dim strProductName As String = Nothing
        Dim intMonths As Integer = CInt(Months)
        Dim datLastMonth As DateTime = CDate(LastMonth)
        Dim blnUseSalesOrders As Boolean
        If CByte(UseSalesOrders) <> 0 Then
            blnUseSalesOrders = True
        End If
        Dim datStartParam As DateTime = datLastMonth.AddMonths(-intMonths)
        'End date is the last day of the month preceding the date of the last order
        Dim datEndParam As DateTime = datLastMonth.AddDays(-1)

        'Create an array of months in ascending date sequence
        Dim intMonth As Integer
        Dim datMonth As DateTime = datLastMonth.AddMonths(-1)
        Dim astrFinal(intMonths - 1, 5) As String
        For intMonth = intMonths To 1 Step -1
            astrFinal(intMonth - 1, 0) = ProductID.ToString
            astrFinal(intMonth - 1, 1) = datMonth.Year.ToString
            astrFinal(intMonth - 1, 2) = datMonth.Month.ToString
            astrFinal(intMonth - 1, 3) = intMonth.ToString
            astrFinal(intMonth - 1, 4) = "0"
            astrFinal(intMonth - 1, 5) = "0"
            datMonth = datMonth.AddMonths(-1)
        Next intMonth
        'Execute the appropriate stored procedure
        If blnUseSalesOrders Then
            strSQL = "usp_GetSalesOrdersAggregates"
        Else
            strSQL = "usp_GetOrdersAggregates"
        End If
        Try
            cnNwind.Open()
            With cmNwind
                .Connection = cnNwind
                .Parameters.Clear()
                .CommandText = strSQL
                .Parameters.AddWithValue("@ProductID", ProductID)
                .Parameters.AddWithValue("@StartDate", datStartParam)
                .Parameters.AddWithValue("@EndDate", datEndParam)
                .CommandType = CommandType.StoredProcedure
            End With
            If blnUseSalesOrders Then
                'For very slow machines with very large SalesOrders tables
                'cmNwind.CommandTimeout = 120
            Else
                'cmNwind.CommandTimeout = 30
            End If
            Dim rdrData As SqlDataReader = cmNwind.ExecuteReader
            Dim intRow As Integer
            Dim astrData(intMonths - 1, 5) As String
            With rdrData
                If .HasRows Then
                    While .Read
                        astrData(intRow, 0) = .GetInt32(0).ToString 'Product ID
                        astrData(intRow, 1) = .GetInt32(1).ToString 'Year
                        astrData(intRow, 2) = .GetInt32(2).ToString 'Month
                        astrData(intRow, 3) = .GetInt64(3).ToString 'MonthNum (x)
                        astrData(intRow, 4) = .GetInt32(4).ToString 'TotalUnits (y)
                        astrData(intRow, 5) = .GetInt32(5).ToString 'TotalSales
                        If intRow = 0 Then
                            strProductName = .GetString(6)
                        End If
                        intRow += 1
                    End While
                    .Close()
                    cnNwind.Close()
                Else
                    .Close()
                    cnNwind.Close()
                    Throw New Exception("No rows returned by stored procedure")
                    Return
                End If
            End With

            'Fill the astrFinal array with matching astrData values
            Dim intMax As Integer = intRow
            For intRow = 0 To intMax - 1
                For intMonth = 0 To intMonths - 1
                    If astrData(intRow, 1) = astrFinal(intMonth, 1) And _
                     astrData(intRow, 2) = astrFinal(intMonth, 2) Then
                        astrFinal(intMonth, 4) = astrData(intRow, 4)
                        astrFinal(intMonth, 5) = astrData(intRow, 5)
                        Exit For
                    End If
                Next
            Next

            'Linear Regression variables
            Dim SumX As Long, SumY As Long, SumXY As Long, SumX2 As Long
            Dim SumY2 As Long, SumSales As Decimal, N As Integer, b As Double
            Dim a As Double, r As Double, t As Double, t95 As Boolean, t99 As Boolean
            Dim intRows As Integer
            For intRow = 0 To intMonths - 1
                SumX += CLng(astrFinal(intRow, 3))
                SumY += CLng(astrFinal(intRow, 4))
                SumXY += CLng(astrFinal(intRow, 3)) * CLng(astrFinal(intRow, 4))
                SumX2 += CLng(astrFinal(intRow, 3)) * CLng(astrFinal(intRow, 3))
                SumY2 += CLng(astrFinal(intRow, 4)) * CLng(astrFinal(intRow, 4))
                SumSales += CLng(astrFinal(intRow, 5))
                intRows += 1
            Next intRow
            N = intMonths
            b = (SumXY - (SumX * SumY) / N) / (SumX2 - (SumX * SumX) / N) 'Slope
            a = SumY / N - (b * SumX / N) 'Intercept
            'Correlation coefficient
            r = Abs(SumXY - (SumX * SumY) / N) / + _
             (Sqrt(SumX2 - ((SumX * SumX) / N)) * Sqrt(SumY2 - ((SumY * SumY) / N)))
            t = r * Sqrt((N - 2) / (1 - (r * r))) 'Significance test (student's t)
            'Confidence intervals - 95% and 99%
            If N > 3 Then
                Dim df As Integer = N - 2
                Dim tCrit95 As Double
                Select Case df
                    Case Is >= 20
                        tCrit95 = 2.086
                    Case Is >= 10
                        tCrit95 = 2.228
                    Case Is >= 8
                        tCrit95 = 2.306
                    Case Is >= 5
                        tCrit95 = 2.571
                    Case Is >= 4
                        tCrit95 = 2.776
                    Case Is >= 3
                        tCrit95 = 3.182
                    Case Is >= 2
                        tCrit95 = 4.303
                End Select
                If t >= tCrit95 Then
                    t95 = True
                End If

                Dim tCrit99 As Double
                Select Case df
                    Case Is >= 20
                        tCrit99 = 2.845
                    Case Is >= 10
                        tCrit99 = 3.169
                    Case Is >= 8
                        tCrit99 = 3.554
                    Case Is >= 5
                        tCrit99 = 4.032
                    Case Is >= 4
                        tCrit99 = 4.604
                    Case Is >= 3
                        tCrit99 = 5.841
                    Case Is >= 2
                        tCrit99 = 9.925
                End Select
                If t >= tCrit99 Then
                    t99 = True
                End If
            End If
            Dim dblAverageUnits As Double = SumY / N
            Dim decAverageSales As Decimal = CDec(SumSales / N)

            'Define and populate the SqlDataRecord
            Dim mdRegr(10) As SqlMetaData
            mdRegr(0) = New SqlMetaData("ProductID", SqlDbType.Int)
            mdRegr(1) = New SqlMetaData("ProductName", SqlDbType.NVarChar, 40)
            mdRegr(2) = New SqlMetaData("StartDate", SqlDbType.DateTime)
            mdRegr(3) = New SqlMetaData("Months", SqlDbType.TinyInt)
            mdRegr(4) = New SqlMetaData("Intercept", SqlDbType.Decimal, 16, 6)
            mdRegr(5) = New SqlMetaData("Slope", SqlDbType.Decimal, 12, 6)
            mdRegr(6) = New SqlMetaData("Correlation", SqlDbType.Decimal, 7, 6)
            mdRegr(7) = New SqlMetaData("Significance", SqlDbType.Decimal, 10, 6)
            mdRegr(8) = New SqlMetaData("Confidence", SqlDbType.TinyInt)
            mdRegr(9) = New SqlMetaData("AverageUnits", SqlDbType.Int)
            mdRegr(10) = New SqlMetaData("AverageSales", SqlDbType.Money)
            Dim sdrRegr As New SqlDataRecord(mdRegr)
            sdrRegr.SetSqlInt32(0, ProductID)
            If strProductName IsNot Nothing Then
                sdrRegr.SetSqlString(1, strProductName)
            End If
            sdrRegr.SetSqlDateTime(2, datStartParam)
            sdrRegr.SetSqlByte(3, CByte(Months))
            sdrRegr.SetSqlDecimal(4, CDec(a))
            sdrRegr.SetSqlDecimal(5, CDec(b))
            sdrRegr.SetSqlDecimal(6, CDec(r))
            sdrRegr.SetSqlDecimal(7, CDec(t))
            If t95 Then
                sdrRegr.SetSqlByte(8, CByte(95))
            End If
            If t99 Then
                sdrRegr.SetSqlByte(8, CByte(99))
            End If
            sdrRegr.SetSqlInt32(9, CInt(dblAverageUnits))
            sdrRegr.SetSqlMoney(10, decAverageSales)
            'Send the LinearRegression record
            Dim spRegr As SqlPipe = SqlContext.Pipe
            spRegr.Send(sdrRegr)
        Catch exc As Exception
            Throw New Exception(exc.Message + exc.StackTrace)
        End Try
    End Sub

End Class