ordersxml.vb

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

Option Explicit On
Option Strict On
Imports System.Data
Imports System.Data.Sql
Imports System.Data.SqlClient
Imports System.Xml
Imports System.Text
Imports System.IO

Partial Public Class NwXmlCols
	'Orders tab procedures and functions for Orders and SalesOrders tables
	Private blnIsOrderXML1 As Boolean
	Private blnIsOrderXML2 As Boolean
	Private blnSalesOrders As Boolean
	Private intXML1Start As Integer
	Private intXML2Start As Integer
	Private intSORows As Integer
	Private blnGetIndexStats As Boolean = True 'First time only
	Private intSizeErrors As Integer
	'True by default; set false to obtain baseline document generation times
	Private blnUpdateCols As Boolean = My.Settings.UpdateColumns
	'Temporary (hopefully)
	Private strSizeError As String = "error(s) have occurred during modifications of " + _
	 "the table's xml column's content. These errors result in NULL xml column " + _
	 "values. " + vbCrLf + " To correct this problem you must restart the program, " + _
	 "which (by default) runs 'DBCC CLEANTABLE' on tables with xml columns. If you've set " + _
	 "the CleanTablesOnStart user setting to False, change the setting to True before " + _
	 "restarting the project."

	Private Sub chkUseSalesOrders_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkUseSalesOrders.CheckedChanged
		'Change from default Orders to SalesOrders table and vice-versa
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		If chkUseSalesOrders.Checked Then
			tabNwindXml.TabPages("pagOrders").Text = "SalesOrders Table"
			tabNwindXml.TabPages("pagOrdersXQuery").Text = "SalesOrders XQuery"
			gbOrdersXQuery.Text = "SalesOrders Table XQuery FLWOR Expressions"
			rbGetAllOrdersF.Text = "Get Max"
			Dim strMsg As String = "Specify the number of SalesOrders rows to update with " + _
			   "XML documents." + vbCrLf + vbCrLf + "Enter 0 or click Cancel to return to the Orders table."
			Dim strRows As String = InputBox(strMsg, "Set Number of SalesOrders Rows to Update or Query", "10000")
            Application.DoEvents()
			intSORows = 0
			If strRows IsNot Nothing Then
				Try
					intSORows = Integer.Parse(strRows)
				Catch exc As Exception
					If exc.Message.Contains("correct format") Then
						txtOrderData.Text = "Invalid string format for SalesOrders rows."
					Else
						txtOrderData.Text = exc.Message
					End If
					Return
				End Try
			End If
			If intSORows > 0 Then
				Me.Cursor = Cursors.WaitCursor
				'Test for existence of OrderXML1 and OrderXML2
				'If present, get the starting record for incremental addition
				'If not, add the column(s)
				txtOrderSQL.Text = "Getting SalesOrder xml column properties" + vbCrLf
                Application.DoEvents()
				Dim strSQL As String = "SELECT MAX(OrderID) FROM SalesOrders " + _
				  "WHERE OrderXML1 IS NOT NULL; "
				Try
					cmNwind.CommandText = strSQL
					cnNwind.Open()
					intXML1Start = CInt(cmNwind.ExecuteScalar) + 1
					If intXML1Start > intSOrderIDMin Then
						chkOrderXML1Index.Enabled = True
					End If
				Catch exc As Exception
					If exc.Message.Contains("Invalid column name") Then
						'Add the column
						strSQL = "ALTER TABLE SalesOrders ADD OrderXML1 xml NULL; "
						cmNwind.CommandText = strSQL
						Try
							cmNwind.ExecuteNonQuery()
							intXML1Start = intSOrderIDMin
							txtOrderSQL.Text += strSQL + vbCrLf
						Catch excXML1 As Exception
							txtOrderSQL.Text += excXML1.Message + vbCrLf
						End Try
					ElseIf exc.Message.Contains("Conversion from type 'DBNull'") Then
						'No updated rows
						intXML1Start = intSOrderIDMin
					Else
						txtOrderSQL.Text += exc.Message
					End If
				Finally
					btnOrderCols.Text = "Drop xml Columns"
					cnNwind.Close()
					txtOrderSQL.Text += "OrderXML1 column will start updates at OrderID " + _
					 intXML1Start.ToString + vbCrLf
				End Try
				strSQL = "SELECT MAX(OrderID) FROM SalesOrders " + _
				 "WHERE OrderXML2 IS NOT NULL; "
				Try
					cmNwind.CommandText = strSQL
					cnNwind.Open()
					intXML2Start = CInt(cmNwind.ExecuteScalar) + 1
					If intXML2Start > intSOrderIDMin Then
						chkOrderXML2Index.Enabled = True
					End If
				Catch exc As Exception
					If exc.Message.Contains("Invalid column name") Then
						strSQL = "ALTER TABLE SalesOrders ADD OrderXML2 xml NULL; "
						cmNwind.CommandText = strSQL
						Try
							cmNwind.ExecuteNonQuery()
							intXML2Start = intSOrderIDMin
							txtOrderSQL.Text += strSQL + vbCrLf
						Catch excXML2 As Exception
							txtOrderSQL.Text += excXML2.Message + vbCrLf
						End Try
					ElseIf exc.Message.Contains("Conversion from type 'DBNull'") Then
						intXML2Start = intSOrderIDMin
					Else
						txtOrderSQL.Text += exc.Message
					End If
				Finally
					cnNwind.Close()
					txtOrderSQL.Text += "OrderXML2 column will start updates at OrderID " + _
					  intXML2Start.ToString + vbCrLf
				End Try
                Application.DoEvents()
				If blnGetIndexStats Then
					'sys.dm_db_index_physical_stats is a very heavyweight operation
					txtOrderSQL.Text += "Getting index data with sys.dm_db_index_physical_stats"
                    Application.DoEvents()
					'In NwXMLCols.vb
					txtOrderData.Text = GetXMLIndexStats("SalesOrders", "OrderXML1")
					SetIndexCheckBoxes("SalesOrders", txtOrderData.Text)
					blnGetIndexStats = False
				Else
					'Lighter-weight operation
					cnNwind.Open()
					GetTableXmlIndexes("SalesOrders")
				End If
                Application.DoEvents()
				If cnNwind.State <> ConnectionState.Open Then
					cnNwind.Open()
				End If
				'Check existence of schema collections (in NwXmlCols.vb)
				TestSchemaCollections("SalesOrder")
				cnNwind.Close()

				Dim blnXML2 As Boolean
				If blnXML2 Then
					blnBypassHandler = True
					Dim xrSchema As XmlReader = Nothing
					'Test for existence of XML2 SchemaCollection
					strSQL = "SELECT xml_schema_namespace(N'dbo',N'SalesOrderXML2SchemaColl')"
					strSQL += ".query('/xs:schema[@targetNamespace=""http://www.northwind.com/schemas/SalesOrder""]')"
					cmNwind.CommandText = strSQL
					Try
						cnNwind.Open()
						'Read the schema, if present
						xrSchema = cmNwind.ExecuteXmlReader
						cnNwind.Close()
						If xrSchema Is Nothing Then
							chkOrderXML2Schema.Checked = False
						Else
							xrSchema.Close()
							chkOrderXML2Schema.Checked = True
						End If
					Catch exc As Exception
						chkOrderXML2Schema.Checked = False
					Finally
						If xrSchema IsNot Nothing Then
							xrSchema.Close()
						End If
						cnNwind.Close()
					End Try
				End If
				'For safety
				blnBypassHandler = False
				Me.Cursor = Cursors.Default
				blnSalesOrders = True
				txtMaxRows.Text = intSORows.ToString
			Else
				chkUseSalesOrders.Checked = False
			End If
		Else
			'Last OrderID
			intXML1Start = CInt(alOrderIDs(alOrderIDs.Count - 1)) + 1
			intXML2Start = intXML1Start
			'Captions
			tabNwindXml.TabPages("pagOrders").Text = "Orders Table"
			tabNwindXml.TabPages("pagOrdersXQuery").Text = "Orders XQuery"
			gbOrdersXQuery.Text = "Orders Table XQuery FLWOR Expressions"
			rbGetAllOrdersF.Text = "Get All"
			blnSalesOrders = False
			'Indexes
			cnNwind.Open()
			GetTableXmlIndexes("Orders")
			cnNwind.Close()
			txtMaxRows.Text = alOrderIDs.Count.ToString
		End If
	End Sub

	Private Sub GetTableXmlIndexes(ByVal strTableName As String)
		'Use lighter-weight sys.indexes for changes between Orders and SalesOrders
		'Expects an open connection
		Dim strSQL As String = "SELECT name FROM sys.indexes WHERE type_desc = 'XML'; "
		Dim rdrData As SqlDataReader = Nothing
		Dim strIndexes As String = Nothing
		cmNwind.CommandText = strSQL
		Try
			rdrData = cmNwind.ExecuteReader()
			With rdrData
				If .HasRows Then
					While .Read
						strIndexes += .GetString(0) + ", "
					End While
					.Close()
					SetIndexCheckBoxes(strTableName, strIndexes)
				Else
					'Error
				End If
			End With
		Catch exc As Exception
			'Error
		Finally
			If Not rdrData.IsClosed Then
				rdrData.Close()
			End If
		End Try
	End Sub

	Private Sub SetIndexCheckBoxes(ByVal strTableName As String, ByVal strIndexes As String)
		Dim strName As String = Nothing
		If strTableName = "SalesOrders" Then
			strName = "SalesOrder"
		ElseIf strTableName = "Orders" Then
			strName = "Order"
		ElseIf strTableName = "Customers" Then
			strName = "Customer"
		End If
		blnBypassHandler = True
		If strName = "Customer" Then
			'Set XML1 and XML2 index check boxes
			If strIndexes.Contains("pidx_" + strName + "XML1") Then
				chkCustXML1Index.Checked = True
			Else
				chkCustXML1Index.Checked = False
			End If
			If strIndexes.Contains("pidx_" + strName + "XML2") Then
				chkCustXML2Index.Checked = True
			Else
				chkCustXML2Index.Checked = False
			End If
		Else
			'Set XML1 index check boxes
			If strIndexes.Contains("pidx_" + strName + "XML1") Then
				chkOrderXML1Index.Checked = True
			Else
				chkOrderXML1Index.Checked = False
			End If
			If strIndexes.Contains("sidx_path_" + strName + "XML1") Then
				chkOrderXML1IndexPath.Checked = True
			Else
				chkOrderXML1IndexPath.Checked = False
			End If
			If strIndexes.Contains("sidx_value_" + strName + "XML1") Then
				chkOrderXML1IndexValue.Checked = True
			Else
				chkOrderXML1IndexValue.Checked = False
			End If
			If strIndexes.Contains("sidx_prop_" + strName + "XML1") Then
				chkOrderXML1IndexProp.Checked = True
			Else
				chkOrderXML1IndexProp.Checked = False
			End If
			'Set XML2 index check boxes
			If strIndexes.Contains("pidx_" + strName + "XML2") Then
				chkOrderXML2Index.Checked = True
			Else
				chkOrderXML2Index.Checked = False
			End If
			If strIndexes.Contains("sidx_path_" + strName + "XML2") Then
				chkOrderXML2IndexPath.Checked = True
			Else
				chkOrderXML2IndexPath.Checked = False
			End If
			If strIndexes.Contains("sidx_value_" + strName + "XML2") Then
				chkOrderXML2IndexValue.Checked = True
			Else
				chkOrderXML2IndexValue.Checked = False
			End If
			If strIndexes.Contains("sidx_prop_" + strName + "XML2") Then
				chkOrderXML2IndexProp.Checked = True
			Else
				chkOrderXML2IndexProp.Checked = False
			End If
		End If
		blnBypassHandler = False
	End Sub

	Private Sub btnOrderCols_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOrderCols.Click
		Try
			txtOrderSQL.Text = ""
			If blnSalesOrders And btnOrderCols.Text.IndexOf("rop") > 0 Then
				'Confirm dropping SalesOrder xml columns
				Dim strMsg As String = "The SalesOrders table has " + (intXML1Start - intSOrderIDMin).ToString + _
				" OrderXML1 rows and " + (intXML2Start - intSOrderIDMin).ToString + " OrderXML2 rows updated with XML documents. " + _
				vbCrLf + vbCrLf + "Are you sure you want to drop the columns?"
				If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "Dropping SalesOrder xml Columns") = MsgBoxResult.No Then
					Return
				End If
			End If
			Dim strSQL As String = Nothing
			If blnSalesOrders Then
				strSQL = "ALTER TABLE SalesOrders "
			Else
				strSQL = "ALTER TABLE Orders "
			End If
			Dim blnCreate As Boolean
			If btnOrderCols.Text.IndexOf("dd") > 0 Then
				strSQL += "ADD OrderXML1 xml NULL, OrderXML2 xml NULL; "
				OrdersControlState(True)
				blnCreate = True
			Else
				blnBypassHandler = True
				chkOrderXML1Schema.Checked = False
				chkOrderXML1Index.Checked = False
				chkOrderXML2Schema.Checked = False