ordersxml.vb

wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重推荐,电子书,电子书下载

			.Indent = True
			.IndentChars = ("  ")
			.OmitXmlDeclaration = False
			.ConformanceLevel = ConformanceLevel.Document
		End With
		Dim xwOrder As XmlWriter
		Dim blnUseSB As Boolean = True 'StringBuilder is simpler than traditional MemoryStream
		If blnUseSB Then
			xwOrder = XmlWriter.Create(sbXML, xwSettings)
		Else
			xwOrder = XmlWriter.Create(msOrder, xwSettings)
		End If
		With xwOrder
			.WriteStartElement("Order")
			.WriteElementString("OrderID", sdrOrder.GetInt32(0).ToString)
			.WriteElementString("CustomerID", sdrOrder.GetString(1))
			.WriteElementString("EmployeeID", sdrOrder.GetInt32(2).ToString)
            .WriteElementString("OrderDate", sdrOrder.GetDateTime(3).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
            .WriteElementString("RequiredDate", sdrOrder.GetDateTime(4).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
			If Not sdrOrder.IsDBNull(5) Then
                .WriteElementString("ShippedDate", sdrOrder.GetDateTime(5).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
			End If
			.WriteElementString("ShipVia", sdrOrder.GetInt32(6).ToString)
			.WriteElementString("Freight", sdrOrder.GetDecimal(7).ToString)
			.WriteElementString("ShipName", sdrOrder.GetString(8).ToString)
			.WriteElementString("ShipAddress", sdrOrder.GetString(9))
			.WriteElementString("ShipCity", sdrOrder.GetString(10))
			If Not sdrOrder.IsDBNull(11) Then
				.WriteElementString("ShipRegion", sdrOrder.GetString(11))
			End If
			If Not sdrOrder.IsDBNull(12) Then
				.WriteElementString("ShipPostalCode", sdrOrder.GetString(12))
			End If
			.WriteElementString("ShipCountry", sdrOrder.GetString(13))
			.WriteEndElement()
			.Flush()
			.Close()
        End With
        sdrOrder.Close()
		Dim strOrderXML1 As String = Nothing
		If blnUseSB Then
			strOrderXML1 = sbXML.ToString
		Else
			strOrderXML1 = Encoding.Unicode.GetString(msOrder.GetBuffer())
			Dim intLength As Integer = strOrderXML1.IndexOf("</Order>") + 7
			strOrderXML1 = strOrderXML1.Substring(1, intLength)
		End If
		msOrder.Close()
		lngBytes += strOrderXML1.Length
		'Fixup for '
		Return Replace(strOrderXML1, "'", "''")
	End Function

	Private Sub btnFillOrderXML2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFillOrderXML2.Click
		Me.Cursor = Cursors.WaitCursor
		OrdersControlState(False)
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		If blnSalesOrders Then
			txtOrderData.Text = "Starting at OrderID " + intXML2Start.ToString
		End If
		Dim strSQL As String
		Dim intOrderID As Integer
		Dim intRow As Integer
		objTimer = New Stopwatch

		blnIsOrderXML2 = True
		intRows = 0
		intSizeErrors = 0
		pbFillColumn.Value = 0
		If blnSalesOrders Then
			pbFillColumn.Maximum = intSORows
		Else
			pbFillColumn.Maximum = alOrderIDs.Count
		End If
		ClearTimingData()
        Application.DoEvents()
		lngBytes = 0
		cmNwind.Parameters.Add("@OrderID", SqlDbType.Int)
		cmNwind.Parameters(0).Direction = ParameterDirection.Input
		cnNwind.Open()
		Dim intMaxRows As Integer
		If blnSalesOrders Then
			intMaxRows = intSORows
		Else
			intMaxRows = alOrderIDs.Count
		End If
		objTimer.Start()
		For intRow = 0 To intMaxRows - 1
			If blnSalesOrders Then
				intOrderID = intXML2Start + intRow
			Else
				intOrderID = CInt(alOrderIDs(intRow))
			End If
			Try
				If blnUpdateCols Then
					If blnSalesOrders Then
						strSQL = "UPDATE SalesOrders "
					Else
						strSQL = "UPDATE Orders "
					End If
					strSQL += "SET OrderXML2 = N'" + CreateOrderXML2Doc(intOrderID) + _
					 "' WHERE OrderID = @OrderID; "
					cmNwind.CommandText = strSQL
					intRows += cmNwind.ExecuteNonQuery
				Else
					intOrderID = intOrderID - intSORows
					strSQL = "-- Baseline time without UPDATE operations" + _
					vbCrLf + CreateOrderXML2Doc(intOrderID)
					intRows += 1
				End If
				pbFillColumn.Value = intRows
				If intRow = 0 Then
					txtOrderSQL.Text = strSQL
                    Application.DoEvents()
				End If
				If intRows Mod 10 = 0 Then
					txtRows.Text = intRows.ToString
                    Application.DoEvents()
				End If
			Catch exc As Exception
				If exc.Message.Contains("Cannot create") Then
					txtOrderData.Text += "OrderID: " + intOrderID.ToString
					intSizeErrors += 1
				End If
				txtOrderData.Text = exc.Message + vbCrLf
                Application.DoEvents()
			End Try
		Next
		dblTime = objTimer.ElapsedTime
		objTimer.Done()
		cmNwind.Parameters.Clear()
		txtTime.Text = dblTime.ToString("0.000")
		cnNwind.Close()
		If intSizeErrors > 0 Then
			Dim strMsg As String = intSizeErrors.ToString + " " + strSizeError
			MsgBox(strMsg, MsgBoxStyle.Critical, "Row Size Errors During Fill")
		End If
		If blnUpdateCols Then
			If blnSalesOrders Then
				intXML2Start = intOrderID + 1
				txtOrderData.Text = SaveAndDisplayData("SalesOrders", "OrderXML2", intOrderID)
				If txtOrderData.Text.Contains("Can't find OrderID") Then
					intXML2Start -= intMaxRows
				End If
			Else
				intXML2Start = CInt(alOrderIDs(alOrderIDs.Count - 1)) + 1
				txtOrderData.Text = SaveAndDisplayData("Orders", "OrderXML2", intOrderID)
			End If
		End If
		If chkBytes.Checked Then
			lblRowsPerSec.Text = "KB/Sec:"
			Dim dblKB As Double = lngBytes / 1000
			txtRows.Text = dblKB.ToString("#,##0.0")
			txtRowsPerSec.Text = (dblKB / dblTime).ToString("#0.0")
		Else
			txtRows.Text = intRows.ToString
			txtRowsPerSec.Text = (intRows / dblTime).ToString("#0.0")
		End If
		Me.Cursor = Cursors.Default
		OrdersControlState(True)
		chkOrderXML2Index.Enabled = True
		btnFillOrderXML2.Focus()
	End Sub

	Private Function CreateOrderXML2Doc(ByVal intOrderID As Integer) As String
		'Create the SalesOrder XML document with an XmlWriter
		'The following is a variation on Chapter 11's csp_SalesOrderXML_NS
		'SQL/CLR stored procedure
        Dim sdrOrder As SqlDataReader
		Dim strSQL As String = Nothing
		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 " + _
		 "AND c.CustomerID = o.CustomerID AND e.EmployeeID = o.EmployeeID " + _
		 "AND s.ShipperID = o.ShipVia"
		If blnSalesOrders Then
			strSQL = Replace(strSQL, "Orders", "SalesOrders")
		End If
		Try
			With cmNwind
				.Parameters(0).Value = intOrderID
				.CommandText = strSQL
                sdrOrder = .ExecuteReader
			End With
		Catch exc As Exception
			Return "Error executing query"
		End Try
        If sdrOrder.HasRows() Then
            sdrOrder.Read()
        Else
            Return "Order is missing"
        End If
		Dim sbOrder As New StringBuilder
		Dim xwSettings As New XmlWriterSettings
		With xwSettings
			.Encoding = Encoding.Unicode
			.Indent = True
			.IndentChars = ("  ")
			.OmitXmlDeclaration = False
			.ConformanceLevel = ConformanceLevel.Document
		End With
		Dim xwOrder As XmlWriter = XmlWriter.Create(sbOrder, 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"

		'Setting the following to False causes an "Undefined or prohibited attribute" validation error
        Dim blnQualifiedAttributes As Boolean = True
        Dim decFreight As Decimal
		With xwOrder
			.WriteStartElement("nwso", "SalesOrder", strNwSo)
			If blnQualifiedAttributes Then
				.WriteAttributeString("nwso", "OrderID", strNwSo, sdrOrder.GetInt32(0).ToString)
                .WriteAttributeString("nwso", "OrderDate", strNwSo, sdrOrder.GetDateTime(16).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
				.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)
			Else
				.WriteAttributeString("OrderID", sdrOrder.GetInt32(0).ToString)
                .WriteAttributeString("OrderDate", sdrOrder.GetDateTime(16).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
				.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)
			End If
			'Temporary test for SchemaCollection applied
			'.WriteElementString("SalesOrderNumber", sdrOrder.GetInt32(0).ToString)
			.WriteElementString("nwso", "SalesOrderNumber", strNwSo, sdrOrder.GetInt32(0).ToString)
            .WriteElementString("nwso", "SalesOrderDate", strNwSo, sdrOrder.GetDateTime(16).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
			.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).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
            .WriteElementString("nwso", "RequiredDate", strNwSo, sdrOrder.GetDateTime(17).ToUniversalTime.ToString("yyyy-MM-ddTHH:mm:ssZ"))
			.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
        'Estimated freight
        decFreight = 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"
		If blnSalesOrders Then
			strSQL = Replace(strSQL, "[Order Details]", "SalesOrderItems")
		End If
		Dim sdrItem As SqlDataReader = Nothing