ordersxml.vb

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

		Try
			With cmNwind
				.CommandText = strSQL
				sdrItem = .ExecuteReader
			End With
		Catch exc As Exception
			If Not sdrItem.IsClosed Then
				sdrItem.Close()
			End If
			Return exc.Message
		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()
			Else
				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 strOrderXML2 As String = sbOrder.ToString
		lngBytes += strOrderXML2.Length
		'Fixup for '
		Return Replace(strOrderXML2, "'", "''")
	End Function

	Private Sub chkOrderXML1Schema_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkOrderXML1Schema.CheckedChanged
		If blnBypassHandler Then
			blnBypassHandler = False
			Return
		End If
		If blnSalesOrders Then
			Dim strMsg As String = "Creating or dropping a schema requires dropping " + _
			"all existing XML indexes on the 'SalesOrders' table, dropping the 'OrderXML1' column, " + _
			"dropping or creating the 'SalesOrderXML1SchemaColl' SchemaCollection, " + _
			"and (optionally) recreating the original xml indexes, if the Index check box is marked." + vbCrLf + vbCrLf + _
			"If you have a large number of updated OrderXML1 documents, " + _
			"you must recreate them." + vbCrLf + vbCrLf + "Are you SURE you want to do this now? "
			If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "Changing SalesOrdersXML1SchemaColl") = MsgBoxResult.No Then
				blnBypassHandler = True
				chkOrderXML1Schema.Checked = Not chkOrderXML1Schema.Checked
				Return
			End If
		End If
		'Create the SchemaCollection
		Me.Cursor = Cursors.WaitCursor
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		Dim strSchemaTable As String
		Dim strSO As String = Nothing
		If blnSalesOrders Then
			strSchemaTable = "SalesOrders"
			strSO = "Sales"
		Else
			strSchemaTable = "Orders"
		End If
		If chkOrderXML1Schema.Checked Then
			txtOrderSQL.Text = CreateXmlSchemaCollection(strSchemaTable, "OrderXML1")
			txtOrderData.Text = ReadXmlSchemaCollection(strSO + "OrderXML1", "") + vbCrLf
		Else
			txtOrderSQL.Text = DropXmlSchemaCollection(strSchemaTable, "OrderXML1")
		End If
		If chkOrderXML1Index.Checked Then
			Dim strMsg As String = "Repopulating the " + strSchemaTable + _
			 "'s OrderXML1 column is faster without indexes." + vbCrLf + vbCrLf + _
			 "Do you want to defer adding indexes until after adding documents?"
			If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "The Dropped xml Column had Indexes") = MsgBoxResult.No Then
				'Recreate the indexes
				CreateOrderXMLIndexes(strSchemaTable, "OrderXML1")
			Else
				blnBypassHandler = True
				chkOrderXML1Index.Checked = False
				blnBypassHandler = False
			End If
		End If
		If blnSalesOrders Then
			If chkOrderXML1Schema.Checked Then
				intXML1Start = GetMinXMLOrderID(True)
			Else
				intXML1Start = GetMinXMLOrderID(False)
			End If
		End If
		Me.Cursor = Cursors.Default
	End Sub

	Private Sub chkOrderXML2Schema_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkOrderXML2Schema.CheckedChanged
		If blnBypassHandler Then
			blnBypassHandler = False
			Return
		End If
		If blnSalesOrders Then
			Dim strMsg As String = "Creating or dropping a schema requires dropping " + _
			"all existing xml indexes on the 'SalesOrders' table, dropping the 'OrderXML2' column, " + _
			"dropping or creating the 'SalesOrderXML2SchemaColl' SchemaCollection, " + _
			"and (optionally) recreating the original XML indexes, if the Index check box is marked." + vbCrLf + vbCrLf + _
			"If you have a large number of updated OrderXML2 documents, " + _
			"you must recreate them." + vbCrLf + vbCrLf + "Are you SURE you want to do this now? "
			If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "Changing SalesOrdersXML2SchemaColl") = MsgBoxResult.No Then
				blnBypassHandler = True
				chkOrderXML2Schema.Checked = Not chkOrderXML2Schema.Checked
				Return
			End If
		End If
		'Create the SchemaCollection
		Me.Cursor = Cursors.WaitCursor
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		Dim strSchemaTable As String
		Dim strSO As String = Nothing
		If blnSalesOrders Then
			strSchemaTable = "SalesOrders"
			strSO = "Sales"
		Else
			strSchemaTable = "Orders"
		End If

		If chkOrderXML2Schema.Checked Then
			txtOrderSQL.Text = CreateXmlSchemaCollection(strSchemaTable, "OrderXML2")
			'Display the entire schema collection
			txtOrderData.Text = ReadXmlSchemaCollection(strSO + "OrderXML2", "http://www.northwind.com/schemas/SalesOrder")
			txtOrderData.Text += ReadXmlSchemaCollection(strSO + "OrderXML2", "http://www.northwind.com/schemas/BillTo")
			txtOrderData.Text += ReadXmlSchemaCollection(strSO + "OrderXML2", "http://www.northwind.com/schemas/SalesContact")
			txtOrderData.Text += ReadXmlSchemaCollection(strSO + "OrderXML2", "http://www.northwind.com/schemas/ShipTo") + vbCrLf
		Else
			txtOrderSQL.Text = DropXmlSchemaCollection(strSchemaTable, "OrderXML2")
		End If
		If chkOrderXML2Index.Checked Then
			Dim strMsg As String = "Repopulating the " + strSchemaTable + _
			 "'s OrderXML2 column is faster without indexes." + vbCrLf + vbCrLf + _
			 "Do you want to defer adding indexes until after adding documents?"
			If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "The Dropped xml Column had Indexes") = MsgBoxResult.No Then
				'Recreate the indexes
				CreateOrderXMLIndexes(strSchemaTable, "OrderXML2")
			Else
				blnBypassHandler = True
				chkOrderXML2Index.Checked = False
				blnBypassHandler = False
			End If
		End If
		If blnSalesOrders Then
			If chkOrderXML2Schema.Checked Then
				intXML2Start = GetMinXMLOrderID(True)
			Else
				intXML2Start = GetMinXMLOrderID(False)
			End If
		End If
		Me.Cursor = Cursors.Default
	End Sub

	Private Function GetMinXMLOrderID(ByVal blnXMLComment As Boolean) As Integer
		'Get the first OrderID value
		Dim intMin As Integer
		Dim strSQL As String = "SELECT MIN(OrderID) FROM SalesOrders"
		cmNwind.CommandText = strSQL
		If cnNwind.State <> ConnectionState.Open Then
			cnNwind.Open()
		End If
		intMin = CInt(cmNwind.ExecuteScalar)
		cnNwind.Close()
		If blnXMLComment Then
			txtOrderData.Text += "<!-- "
		End If
		txtOrderData.Text += "Starting over with SalesOrders table at OrderID " + intXML1Start.ToString
		If blnXMLComment Then
			txtOrderData.Text += " -->"
		End If
		Return intMin
	End Function

	Private Sub chkOrderXML1Index_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkOrderXML1Index.CheckedChanged
		If blnBypassHandler Then
			Return
		End If
		blnGetIndexStats = True
		'Create the specified index on OrderXML1
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		Dim strIndexTable As String
		If blnSalesOrders Then
			strIndexTable = "SalesOrders"
		Else
			strIndexTable = "Orders"
		End If
		If chkOrderXML1Index.Checked Then
			txtOrderSQL.Text = CreateOrderXMLIndexes(strIndexTable, "OrderXML1")
			txtOrderData.Text = GetXMLIndexStats(strIndexTable, "OrderXML1")
			If blnSalesOrders Then
				If intXML1Start = intSOrderIDMin Then
					txtOrderData.Text += "Index Name: ?idx_SalesOrderXML1 stats won't appear until you add some XML content."
				End If
			Else
				If Not txtOrderData.Text.Contains("pidx_OrderXML1") Then
					txtOrderData.Text += "Index Name: ?idx_OrderXML1 stats won't appear until you add some XML content."
				End If
			End If
		Else
			txtOrderSQL.Text = DropXMLIndexes(strIndexTable, "OrderXML1", False)
		End If
		Me.Cursor = Cursors.Default
	End Sub

	Private Sub chkOrderXML2Index_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkOrderXML2Index.CheckedChanged
		'Create the specified index on OrderXML2
		If blnBypassHandler Then
			Return
		End If
		blnGetIndexStats = True
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		Dim strIndexTable As String
		If blnSalesOrders Then
			strIndexTable = "SalesOrders"
		Else
			strIndexTable = "Orders"
		End If
		If chkOrderXML2Index.Checked Then
			txtOrderSQL.Text = CreateOrderXMLIndexes(strIndexTable, "OrderXML2")
			txtOrderData.Text = GetXMLIndexStats(strIndexTable, "OrdersXML2")
			If blnSalesOrders Then
				If intXML2Start = intSOrderIDMin Then
					txtOrderData.Text += "Index Name: ?idx_SalesOrderXML2 stats won't appear until you add some XML content."
				End If
			Else
				If Not txtOrderData.Text.Contains("pidx_OrderXML2") Then
					txtOrderData.Text += "Index Name: ?idx_OrderXML2 stats won't appear until you add some XML content."
				End If
			End If
		Else
			txtOrderSQL.Text = DropXMLIndexes(strIndexTable, "OrderXML2", False)
		End If
		Me.Cursor = Cursors.Default
	End Sub

	Private Function CreateOrderXMLIndexes(ByVal strTableName As String, ByVal strColName As String) As String
		'Create primary and optional secondary XML indexes
		OrdersControlState(False)
		ClearTimingData()
		objTimer = New Stopwatch
		Me.Cursor = Cursors.WaitCursor
        Application.DoEvents()
		Dim strIndexName As String
		If blnSalesOrders Then
			'Prevent duplicate index names
			strIndexName = Replace(strColName, "Order", "SalesOrder")
		Else
			strIndexName = strColName
		End If
		Dim strSQL As String = Nothing
		'Might take a long time
		cmNwind.CommandTimeout = 300
		Try
			strSQL = "CREATE PRIMARY XML INDEX pidx_" + strIndexName + _
			 " ON " + strTableName + " (" + strColName + "); " + vbCrLf
			If (strColName.Contains("XML1") And chkOrderXML1IndexPath.Checked) Or _
			 (strColName.Contains("XML2") And chkOrderXML2IndexPath.Checked) Then
				strSQL += "CREATE XML INDEX sidx_path_" + strIndexName + " ON " + strTableName + _
				 " (" + strColName + ") USING XML INDEX pidx_" + strIndexName + " FOR PATH; " + vbCrLf
			End If
			If (strColName.Contains("XML1") And chkOrderXML1IndexValue.Checked) Or _
			 (strColName.Contains("XML2") And chkOrderXML2IndexValue.Checked) Then
				strSQL += "CREATE XML INDEX sidx_value_" + strIndexName + " ON " + strTableName + _
				 " (" + strColName + ") USING XML INDEX pidx_" + strIndexName + " FOR VALUE; " + vbCrLf
			End If
			If (strColName.Contains("XML1") And chkOrderXML1IndexProp.Checked) Or _
			 (strColName.Contains("XML2") And chkOrderXML2IndexProp.Checked) Then
				strSQL += "CREATE XML INDEX sidx_prop_" + strIndexName + " ON " + strTableName + _
				 " (" + strColName + ") USING XML INDEX pidx_" + strIndexName + " FOR PROPERTY; " + vbCrLf
			End If
			cmNwind.CommandText = strSQL
			If cnNwind.State <> ConnectionState.Open Then
				cnNwind.Open()
			End If
			objTimer.Start()
			cmNwind.ExecuteNonQuery()
			txtTime.Text = objTimer.ElapsedTime.ToString("#0.000")
			objTimer.Done()
			cnNwind.Close()
			If blnSalesOrders Then
				Return "-- Click Fill " + strColName + " to add rows to the SalesOrders column" + vbCrLf + strSQL
			Else
				Return "-- Click Fill " + strColName + " to repopulate the Orders column" + vbCrLf + strSQL
			End If
		Catch exc As Exception
			Return exc.Message + vbCrLf + vbCrLf + strSQL
		Finally
			cnNwind.Close()
			cmNwind.CommandTimeout = 30
			OrdersControlState(True)
			Me.Cursor = Cursors.Default
		End Try
	End Function
End Class