storedprocedures.vb

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

            .WriteElementString("Name", strEmplName)
            .WriteElementString("Title", sdrOrder.GetString(14))
            Dim strEmpPhone As String = "[phone] X" + sdrOrder.GetString(15)
            .WriteElementString("Phone", strEmpPhone)
            strEmail = sdrOrder.GetString(12).ToString.Substring(0, 1).ToLower
            strEmail += sdrOrder.GetString(13).ToLower + "@northwind.com"
            .WriteElementString("EMail", strEmail)
            .WriteEndElement() 'SalesContact
            .WriteStartElement("OrderDates")
            .WriteElementString("OrderDate", sdrOrder.GetDateTime(16).ToString("s"))
            .WriteElementString("RequiredDate", sdrOrder.GetDateTime(17).ToString("s"))
            .WriteEndElement() 'OrderDates
            .WriteStartElement("ShipTo")
            .WriteElementString("Name", sdrOrder.GetString(22))
            .WriteElementString("Address", sdrOrder.GetString(23))
            .WriteElementString("City", sdrOrder.GetString(24))
            If sdrOrder.IsDBNull(25) Then
                .WriteElementString("Region", "")
            Else
                .WriteElementString("Region", sdrOrder.GetString(25))
            End If
            If sdrOrder.IsDBNull(26) Then
                .WriteElementString("PostalCode", "")
            Else
                .WriteElementString("PostalCode", sdrOrder.GetString(26))
            End If
            .WriteElementString("Country", sdrOrder.GetString(27))
            .WriteEndElement() 'ShipTo
            .WriteStartElement("LineItems")
        End With
        'Save estimated freight
        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
                'Use current connection
                .CommandText = strSQL
                sdrItem = .ExecuteReader
            End With
        Catch exc As Exception
            cnNwind.Close()
            Throw New Exception("Exception executing line item query.")
            Return
        End Try
        With sdrItem
            If .HasRows Then
                While .Read
                    intItem += 1
                    xwOrder.WriteStartElement("LineItem")
                    xwOrder.WriteAttributeString("OrderID", intOrderID.ToString)
                    xwOrder.WriteAttributeString("ProductID", .GetInt32(0).ToString)
                    xwOrder.WriteAttributeString("ItemID", intItem.ToString)
                    xwOrder.WriteElementString("ItemNumber", intItem.ToString)
                    xwOrder.WriteElementString("Ordered", .GetInt16(3).ToString)
                    xwOrder.WriteElementString("SKU", .GetInt32(0).ToString)
                    xwOrder.WriteElementString("Product", .GetString(1))
                    xwOrder.WriteElementString("Package", .GetString(2))
                    xwOrder.WriteElementString("ListPrice", .GetDecimal(4).ToString("#0.00"))
                    'Following accommodates real and decimal data types
                    Dim decDisc As Decimal = CDec(.GetValue(5))
                    xwOrder.WriteElementString("Discount", (100 * CDec(.GetValue(5))).ToString("#0.0"))
                    Dim decExt As Decimal = .GetInt16(3) * .GetDecimal(4) * (1 - decDisc)
                    xwOrder.WriteElementString("Extended", (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("Summary")
            .WriteElementString("ItemsOrdered", intItems.ToString)
            .WriteElementString("Subtotal", decAmount.ToString("0.00"))
            .WriteElementString("EstimatedFreight", decFreight.ToString("0.00"))
            Dim decTotal As Decimal = decAmount + decFreight
            .WriteElementString("Total", 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 
                'is 10,487 chars and SqlPipe is limited to 4,000 chars
                'Create multiple 4,000-char columns when necessary
                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_SalesOrderXML_NS(ByVal OrderID As SqlInt32)
        'Save an XML representation of a SalesOrder object as a local file
        'and send the XML document string with a pipe
        'Adds arbitrary namespace prefix for comparison with FOR XML PATH queries
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmNwind As New SqlCommand
        Dim spOrder As SqlPipe = SqlContext.Pipe
        Dim sdrOrder As SqlDataReader = Nothing

        'Get the directory for the SQL Server project (extended property)
        Dim strDir As String = Nothing
        Dim strSQL As String = "SELECT value FROM " + _
         "fn_listextendedproperty('SqlAssemblyProjectRoot', " + _
         "'ASSEMBLY', default, default, default, default, default) " + _
         "WHERE objname = 'StoredProceduresCLR'"
        Try
            cnNwind.Open()
            With cmNwind
                .Connection = cnNwind
                .CommandText = strSQL
                .CommandType = CommandType.Text
                strDir = CStr(.ExecuteScalar)
            End With
        Catch exc As Exception
            cnNwind.Close()
            Throw New Exception("Exception getting folder location.")
            Return
        End Try
        If strDir = Nothing Then
            cnNwind.Close()
            Throw New Exception("No folder location returned by query.")
            Return
        End If

        strDir += "\Test Scripts\"

        strSQL = "SELECT o.OrderID, o.CustomerID, c.CompanyName, c.ContactName, " + _
         "c.ContactTitle, c.Address, c.City, c.Region, c.PostalCode, c.Country, " + _
         "c.Phone, o.EmployeeID, e.FirstName, e.LastName, e.Title, e.Extension, " + _
         "o.OrderDate, o.RequiredDate, o.ShippedDate, o.ShipVia, s.CompanyName, " + _
         "o.Freight, o.ShipName, o.ShipAddress, o.ShipCity, o.ShipRegion, " + _
         "o.ShipPostalCode, o.ShipCountry " + _
         "FROM Orders AS o, Customers AS c, Employees AS e, Shippers AS s " + _
         "WHERE o.OrderID = " + OrderID.ToString + _
         "AND c.CustomerID = o.CustomerID AND e.EmployeeID = o.EmployeeID " + _
         "AND s.ShipperID = o.ShipVia"
        Try
            With cmNwind
                .CommandText = strSQL
                sdrOrder = .ExecuteReader
            End With
            If sdrOrder.HasRows Then
                sdrOrder.Read()
            Else
                sdrOrder.Close()
                cnNwind.Close()
                Throw New Exception("Order " + OrderID.ToString + " is missing.")
                Return
            End If
        Catch exc As Exception
            sdrOrder.Close()
            cnNwind.Close()
            Throw New Exception("Exception executing order body query.")
            Return
        End Try
        If sdrOrder Is Nothing Then
            cnNwind.Close()
            Throw New Exception("Order body query returned nothing.")
            Return
        End If
        'OrderID = 0, CustomerID = 1, CompanyName = 2, ContactName = 3 ContactTitle = 4
        'Address = 5, City = 6, Region = 7, PostalCode = 8, Country = 9, Phone = 10
        'EmployeeID = 11, FirstName = 12, LastName = 13, Title = 14, Extension = 15
        'OrderDate = 16, RequiredDate = 17, ShippedDate = 18, ShipVia = 19, 
        'ShipCompanyName = 20, Freight = 21	'ShipName = 22, ShipAddress = 23, 
        'ShipCity = 24, ShipRegion = 25, ShipPostalCode = 26, ShipCountry = 27
        Dim strFile As String = strDir + "SO" + sdrOrder.GetInt32(0).ToString + ".xml"
        Dim xwSettings As New XmlWriterSettings
        With xwSettings
            .Encoding = Encoding.UTF8
            .Indent = True
            .IndentChars = ("  ")
            .OmitXmlDeclaration = False
            .ConformanceLevel = ConformanceLevel.Document
        End With
        Dim xwOrder As XmlWriter = XmlWriter.Create(strFile, xwSettings)
        Dim strNwNs As String = "http://www.northwind.com/schemas/"
        Dim strNwSo As String = strNwNs + "SalesOrder"
        Dim strNwBt As String = strNwNs + "BillTo"
        Dim strNwSc As String = strNwNs + "SalesContact"
        Dim strNwSt As String = strNwNs + "ShipTo"
        With xwOrder
            .WriteStartElement("nwso", "SalesOrder", strNwSo)
            .WriteAttributeString("nwso", "OrderID", strNwSo, sdrOrder.GetInt32(0).ToString)
            .WriteAttributeString("nwso", "OrderDate", strNwSo, sdrOrder.GetDateTime(16).ToString("s"))
            .WriteAttributeString("nwso", "CustomerID", strNwSo, sdrOrder.GetString(1))
            .WriteAttributeString("nwso", "EmployeeID", strNwSo, sdrOrder.GetInt32(11).ToString)
            .WriteAttributeString("nwso", "PaymentID", strNwSo, "1")
            .WriteAttributeString("nwso", "CurrencyID", strNwSo, "1")
            .WriteAttributeString("nwso", "FobID", strNwSo, "1")
            .WriteAttributeString("nwso", "ShipperID", strNwSo, sdrOrder.GetInt32(19).ToString)
            .WriteElementString("nwso", "SalesOrderNumber", strNwSo, sdrOrder.GetInt32(0).ToString)
            .WriteElementString("nwso", "SalesOrderDate", strNwSo, sdrOrder.GetDateTime(16).ToString("s"))
            .WriteStartElement("nwso", "Terms", strNwSo)
            .WriteElementString("nwso", "Payment", strNwSo, "Net 30 Days")
            .WriteElementString("nwso", "Currency", strNwSo, "US$")
            .WriteEndElement() 'Terms
            .WriteStartElement("nwso", "Shipment", strNwSo)
            .WriteElementString("nwso", "FOB", strNwSo, "Redmond, WA")
            .WriteElementString("nwso", "Shipper", strNwSo, sdrOrder.GetString(20))
            .WriteElementString("nwso", "EstimatedFreight", strNwSo, sdrOrder.GetDecimal(21).ToString("#0.00"))
            .WriteEndElement() 'Shipment
            .WriteStartElement("nwbt", "BillTo", strNwBt)
            .WriteElementString("nwbt", "Name", strNwBt, sdrOrder.GetString(2))
            .WriteElementString("nwbt", "Address", strNwBt, sdrOrder.GetString(5))
            .WriteElementString("nwbt", "City", strNwBt, sdrOrder.GetString(6))
            If sdrOrder.IsDBNull(7) Then
                .WriteElementString("nwbt", "Region", strNwBt, "")
            Else
                .WriteElementString("nwbt", "Region", strNwBt, sdrOrder.GetString(7))
            End If
            If sdrOrder.IsDBNull(8) Then
                .WriteElementString("nwbt", "PostalCode", strNwBt, "")
            Else
                .WriteElementString("nwbt", "PostalCode", strNwBt, sdrOrder.GetString(8))
            End If
            .WriteElementString("nwbt", "Country", strNwBt, sdrOrder.GetString(9))
            .WriteStartElement("nwbt", "Buyer", strNwBt)
            .WriteElementString("nwbt", "Name", strNwBt, sdrOrder.GetString(3))
            .WriteElementString("nwbt", "Title", strNwBt, sdrOrder.GetString(4))
            .WriteElementString("nwbt", "Phone", strNwBt, sdrOrder.GetString(10))
            Dim strEmail As String = sdrOrder.GetString(3)
            strEmail = Replace(strEmail, " ", "_") + "@mail.msn.com"
            .WriteElementString("nwbt", "EMail", strNwBt, strEmail)
            Dim strPurch As String = Now.Ticks.ToString.Substring(12)
            .WriteElementString("nwbt", "PurchaseOrder", strNwBt, strPurch)
            .WriteEndElement() 'Buyer
            .WriteEndElement() 'BillTo
            .WriteStartElement("nwsc", "SalesContact", strNwSc)
            Dim strEmplName As String = sdrOrder.GetString(12) + _
             " " + sdrOrder.GetString(13).ToString
            .WriteElementString("nwsc", "Name", strNwSc, strEmplName)
            .WriteElementString("nwsc", "Title", strNwSc, sdrOrder.GetString(14))
            Dim strEmpPhone As String = "[phone] X" + sdrOrder.GetString(15)
            .WriteElementString("nwsc", "Phone", strNwSc, strEmpPhone)
            strEmail = sdrOrder.GetString(12).ToString.Substring(0, 1).ToLower
            strEmail += sdrOrder.GetString(13).ToLower + "@northwind.com"
            .WriteElementString("nwsc", "EMail", strNwSc, strEmail)
            .WriteEndElement() 'SalesContact
            .WriteStartElement("nwso", "OrderDates", strNwSo)
            .WriteElementString("nwso", "OrderDate", strNwSo, sdrOrder.GetDateTime(16).ToString("s"))
            .WriteElementString("nwso", "RequiredDate", strNwSo, sdrOrder.GetDateTime(17).ToString("s"))
            .WriteEndElement() 'OrderDates
            .WriteStartElement("nwst", "ShipTo", strNwSt)
            .WriteElementString("nwst", "Name", strNwSt, sdrOrder.GetString(22))
            .WriteElementString("nwst", "Address", strNwSt, sdrOrder.GetString(23))
            .WriteElementString("nwst", "City", strNwSt, sdrOrder.GetString(24))
            If sdrOrder.IsDBNull(25) Then
                .WriteElementString("nwst", "Region", strNwSt, "")
            Else
                .WriteElementString("nwst", "Region", strNwSt, sdrOrder.GetString(25))
            End If
            If sdrOrder.IsDBNull(26) Then
                .WriteElementString("nwst", "PostalCode", strNwSt, "")
            Else
                .WriteElementString("nwst", "PostalCode", strNwSt, sdrOrder.GetString(26))
            End If
            .WriteElementString("nwst", "Country", strNwSt, sdrOrder.GetString(27))
            .WriteEndElement() 'ShipTo
            .WriteStartElement("nwso", "LineItems", strNwSo)
        End With
        Dim intOrderID As Integer = sdrOrder.GetInt32(0)