storedprocedures.vb

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

Option Explicit On
Option Strict On

Imports System
Imports System.Data
Imports System.Data.Sql
Imports System.Data.SqlTypes
Imports Microsoft.SqlServer.Server

'Added
Imports System.Data.SqlClient
Imports System.IO
Imports System.Xml
Imports System.Text
Imports System.Math

Partial Public Class StoredProcedures
    <SqlProcedure()> _
      Public Shared Function csp_CustomerDataRecord(ByVal CustomerID As SqlString) As Integer
        'Delivers a single SqlDataRecord to a client SqlDataRecord
        'Define the metadata for an SqlDataRecord (default for USA)
        Dim mdCust(8) As SqlMetaData
        mdCust(0) = New SqlMetaData("ID", SqlDbType.NVarChar, 5)
        mdCust(1) = New SqlMetaData("Company", SqlDbType.NVarChar, 40)
        mdCust(2) = New SqlMetaData("Buyer", SqlDbType.NVarChar, 30)
        mdCust(3) = New SqlMetaData("Title", SqlDbType.NVarChar, 30)
        mdCust(4) = New SqlMetaData("Street", SqlDbType.NVarChar, 60)
        mdCust(5) = New SqlMetaData("City", SqlDbType.NVarChar, 15)
        mdCust(6) = New SqlMetaData("State", SqlDbType.NVarChar, 15)
        mdCust(7) = New SqlMetaData("ZIPCode", SqlDbType.NVarChar, 10)
        mdCust(8) = New SqlMetaData("Country", SqlDbType.NVarChar, 15)

        Dim spCust As SqlPipe = SqlContext.Pipe
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmCust As New SqlCommand
        With cmCust
            .Connection = cnNwind
            .CommandType = CommandType.Text
            .Parameters.Clear()
            .Parameters.AddWithValue("@CustomerID", CustomerID)
            .CommandText = "SELECT CustomerID, CompanyName, ContactName, " + _
             "ContactTitle, Address, City, Region, PostalCode, Country " + _
             "FROM Customers WHERE CustomerID = @CustomerID;"
        End With
        Try
            'SqlDataRecord and SqlCommand.ExecuteRow was removed from SqlClient pre-Beta 2
            'Dim sdrCustOrig As Microsoft.SqlServer.Server.SqlDataRecord = cmCust.ExecuteRow
            cnNwind.Open()
            Dim sdrCustOrig As SqlDataReader = cmCust.ExecuteReader
            If sdrCustOrig.HasRows Then
                sdrCustOrig.Read()
            Else
                Throw New Exception("CustomerID '" + CustomerID.ToString + "' not found.")
                sdrCustOrig.Close()
                cnNwind.Close()
                Return 1
            End If
            Dim intIsUSA As Integer
            If sdrCustOrig(8).ToString = "USA" Then
                intIsUSA = -1
            Else
                'Use international field names
                mdCust(6) = New SqlMetaData("Region", SqlDbType.NVarChar, 15)
                mdCust(7) = New SqlMetaData("PostalCode", SqlDbType.NVarChar, 10)
            End If
            Dim sdrCust As New SqlDataRecord(mdCust)
            Dim intCtr As Integer
            For intCtr = 0 To 8
                If intIsUSA = -1 Then
                    If intCtr = 8 Then
                        'NULL country
                        Exit For
                    End If
                End If
                If sdrCustOrig(intCtr).ToString = "" Then
                    'NULL Region or PostalCode
                Else
                    sdrCust.SetString(intCtr, sdrCustOrig(intCtr).ToString)
                End If
            Next intCtr
            sdrCustOrig.Close()
            cnNwind.Close()
            spCust.Send(sdrCust)
            Return intIsUSA
        Catch exc As Exception
            cnNwind.Close()
            Throw New Exception(exc.Message)
            Return 1
        End Try
    End Function

    <SqlProcedure()> _
    Public Shared Function csp_CustomerDataStream() As Integer
        'Delivers multiple SqlDataRecords to client SqlDataReader
        'Demonstrates inability to change SqlMetaData dynamically per row
        Dim mdCust(8) As SqlMetaData
        mdCust(0) = New SqlMetaData("ID", SqlDbType.NVarChar, 5)
        mdCust(1) = New SqlMetaData("Company", SqlDbType.NVarChar, 40)
        mdCust(2) = New SqlMetaData("Buyer", SqlDbType.NVarChar, 30)
        mdCust(3) = New SqlMetaData("Title", SqlDbType.NVarChar, 30)
        mdCust(4) = New SqlMetaData("Street", SqlDbType.NVarChar, 60)
        mdCust(5) = New SqlMetaData("City", SqlDbType.NVarChar, 15)
        mdCust(6) = New SqlMetaData("State", SqlDbType.NVarChar, 15)
        mdCust(7) = New SqlMetaData("ZIPCode", SqlDbType.NVarChar, 10)
        mdCust(8) = New SqlMetaData("Country", SqlDbType.NVarChar, 15)

        Dim spCusts As SqlPipe = SqlContext.Pipe
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmCusts As New SqlCommand
        With cmCusts
            .Connection = cnNwind
            .CommandType = CommandType.Text
            .CommandText = "SELECT CustomerID, CompanyName, ContactName, " + _
             "ContactTitle, Address, City, Region, PostalCode, Country " + _
             "FROM Customers;"
        End With
        Dim blnUSA As Boolean
        Try
            cnNwind.Open()
            Dim sdrCustOrig As SqlDataReader = cmCusts.ExecuteReader
            Dim sdrCust As New SqlDataRecord(mdCust)
            With sdrCustOrig
                If .HasRows Then
                    spCusts.SendResultsStart(sdrCust)
                Else
                    Throw New Exception("Query returned no rows.")
                    Return 0
                End If
                Dim intRows As Integer
                While .Read
                    'Attempt to change field names (doesn't work, but doesn't throw exception)
                    If sdrCustOrig(8).ToString = "USA" Then
                        mdCust(6) = New SqlMetaData("State", SqlDbType.NVarChar, 15)
                        mdCust(7) = New SqlMetaData("ZIPCode", SqlDbType.NVarChar, 10)
                        blnUSA = True
                    Else
                        mdCust(6) = New SqlMetaData("Region", SqlDbType.NVarChar, 15)
                        mdCust(7) = New SqlMetaData("PostalCode", SqlDbType.NVarChar, 10)
                        blnUSA = False
                    End If
                    sdrCust = New SqlDataRecord(mdCust)
                    Dim intCtr As Integer
                    For intCtr = 0 To 8
                        If blnUSA Then
                            If intCtr = 8 Then
                                'NULL country
                                Exit For
                            End If
                        End If
                        If sdrCustOrig(intCtr).ToString = "" Then
                            'NULL Region or PostalCode
                        Else
                            sdrCust.SetString(intCtr, sdrCustOrig(intCtr).ToString)
                        End If
                    Next intCtr
                    spCusts.SendResultsRow(sdrCust)
                    intCtr += 1
                End While
                spCusts.SendResultsEnd()
                .Close()
                cnNwind.Close()
                Return intRows
            End With
        Catch exc As Exception
            Throw New Exception(exc.Message)
            Return 1
        End Try
    End Function

    <SqlProcedure()> _
      Public Shared Sub csp_SalesOrderXML(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
        'This requires the assembly to be deployed with External Permission Level
        Dim spOrder As SqlPipe = SqlContext.Pipe
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmNwind As New SqlCommand
        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.")
        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 intOrderID As Integer = sdrOrder.GetInt32(0)

        Dim strFile As String = strDir + "SO" + intOrderID.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)
        With xwOrder
            .WriteStartElement("SalesOrder", "http://www.northwind.com/schemas/SalesOrder")
            .WriteAttributeString("OrderID", sdrOrder.GetInt32(0).ToString)
            .WriteAttributeString("OrderDate", sdrOrder.GetDateTime(16).ToString("s"))
            .WriteAttributeString("CustomerID", sdrOrder.GetString(1))
            .WriteAttributeString("EmployeeID", sdrOrder.GetInt32(11).ToString)
            .WriteAttributeString("PaymentID", "1")
            .WriteAttributeString("CurrencyID", "1")
            .WriteAttributeString("FobID", "1")
            .WriteAttributeString("ShipperID", sdrOrder.GetInt32(19).ToString)
            .WriteElementString("SalesOrderNumber", sdrOrder.GetInt32(0).ToString)
            .WriteElementString("SalesOrderDate", sdrOrder.GetDateTime(16).ToString("s"))
            .WriteStartElement("Terms")
            .WriteElementString("Payment", "Net 30 Days")
            .WriteElementString("Currency", "US$")
            .WriteEndElement() 'Terms
            .WriteStartElement("Shipment")
            .WriteElementString("FOB", "Redmond, WA")
            .WriteElementString("Shipper", sdrOrder.GetString(20))
            .WriteElementString("EstimatedFreight", sdrOrder.GetDecimal(21).ToString("#0.00"))
            .WriteEndElement() 'Shipment
            .WriteStartElement("BillTo")
            .WriteElementString("Name", sdrOrder.GetString(2))
            .WriteElementString("Address", sdrOrder.GetString(5))
            .WriteElementString("City", sdrOrder.GetString(6))
            If sdrOrder.IsDBNull(7) Then
                .WriteElementString("Region", "")
            Else
                .WriteElementString("Region", sdrOrder.GetString(7))
            End If
            If sdrOrder.IsDBNull(8) Then
                .WriteElementString("PostalCode", "")
            Else
                .WriteElementString("PostalCode", sdrOrder.GetString(8))
            End If
            .WriteElementString("Country", sdrOrder.GetString(9))
            .WriteStartElement("Buyer")
            .WriteElementString("Name", sdrOrder.GetString(3))
            .WriteElementString("Title", sdrOrder.GetString(4))
            .WriteElementString("Phone", sdrOrder.GetString(10))
            Dim strEmail As String = sdrOrder.GetString(3)
            strEmail = Replace(strEmail, " ", "_") + "@mail.msn.com"
            .WriteElementString("EMail", strEmail)
            Dim strPurch As String = Now.Ticks.ToString.Substring(12)
            .WriteElementString("PurchaseOrder", strPurch)
            .WriteEndElement() 'Buyer
            .WriteEndElement() 'BillTo
            .WriteStartElement("SalesContact")
            Dim strEmplName As String = sdrOrder.GetString(12) + _
             " " + sdrOrder.GetString(13).ToString