nwxmlcols.vb

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

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

Partial Public Class NwXmlCols
	Private cnNwind As SqlConnection
	Private cmNwind As New SqlCommand
	Private strIEFile As String = "\Program Files\Internet Explorer\Iexplore.exe"
	Private blnEnableIE As Boolean
	Private strNS As String
	Private blnTyped As Boolean
	Private strXmlColName As String
	Private intXmlCol As Integer
	Private alCustomerIDs As New ArrayList
	Private alOrderIDs As New ArrayList
	Private blnXML1Exists As Boolean
	Private blnXML2Exists As Boolean
	Private lngBytes As Long
	Private intRows As Integer
	Private dblTime As Double
	Private blnBypassHandler As Boolean
	Private intSORecords As Integer
	Private intSOrderIDMin As Integer
	Private intSOrderIDMax As Integer
	Private blnHasLoaded As Boolean
	Private objTimer As Stopwatch
	Private sbXML As StringBuilder
	'Display last result of random instances
	Private blnShowLast As Boolean
	'For index timing tests - include time to ExecuteReader in elapsed time
	Private blnIncludeReader As Boolean = My.Settings.IncludeOpenReaderInTime
	'Display SHOWPLAN_XML in text box when selecting a test query
	Private blnShowPlanXML As Boolean = My.Settings.DisplayShowplanXML
	Private blnShowPlanInGrid As Boolean = My.Settings.ShowplanInGrid
	'Display STATISTICS_XML in text box instead of SHOWPLAN_XML
	Private blnShowStatsXML As Boolean = My.Settings.DisplayStatisticsXML
	Private blnExpandEntities As Boolean = My.Settings.ExpandShowplanEntities
	'Insert ShowplanXML content into Showplans table
	Private blnInsertShowplans As Boolean = My.Settings.InsertShowplansInTable
	Private intInstanceID As Integer
	Private strLastShowplan As String
	Private blnFromUpdate As Boolean

	Private Sub NwXmlCols_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
		pbFillColumn.Width = 291
		Dim strConn As String = Nothing
		Try
			If File.Exists(strIEFile) Then
				blnEnableIE = True
			End If
			'Set the connection
			strConn = My.Settings.NorthwindConnection
			cnNwind = New SqlConnection(strConn)
			cmNwind.Connection = cnNwind
			cmNwind.CommandType = CommandType.Text
			cnNwind.Open()
			Dim blnDropTables As Boolean = My.Settings.DropOrdersXmlOnStart

			Dim strSQL As String
			Dim intStartTable As Integer
			'SalesOrders table options, if present
			Dim intSOSel As Integer = SalesOrdersSelection()
			If intSOSel > 0 Then
				chkUseSalesOrders.Enabled = True
				If intSOSel = 1 And Not blnDropTables Then
					blnDropTables = True
					intStartTable = 4
				End If
			End If
			'Application.UseWaitCursor = True
			If My.Settings.CleanTablesOnStart Then
				'Following is required to prevent overlong row error messages
				strSQL = "DBCC CLEANTABLE ('Northwind', 'Customers'); " + _
				 "DBCC CLEANTABLE ('Northwind', 'Orders'); "
				If intSOSel > 0 Then
					strSQL += "DBCC CLEANTABLE ('Northwind', 'SalesOrders'); "
				End If
				'Might take a long time
				cmNwind.CommandTimeout = 300
				cmNwind.CommandText = strSQL
				cmNwind.ExecuteNonQuery()
			End If

			If blnDropTables Then
				'Remove Orders table columns and SchemaCollections, if present (clean slate)
				'Remove SalesOrder table columns, if specified
				Dim intCtr As Integer
				Dim strMsg As String = Nothing
				Dim strColName As String = Nothing
				Dim strTableName As String = Nothing
				cmNwind.CommandTimeout = 30
				Dim intTables As Integer
				If intSOSel = 1 Then
					'Drop SalesOrders stuff
					intTables = 5
				Else
					intTables = 3
				End If
				For intCtr = intStartTable To intTables
					Select Case intCtr
						Case 0
							strTableName = "Customers"
							strColName = "CustomerXML1"
						Case 1
							strTableName = "Customers"
							strColName = "CustomerXML2"
						Case 2
							strTableName = "Orders"
							strColName = "OrderXML1"
						Case 3
							strTableName = "Orders"
							strColName = "OrderXML2"
						Case 4
							strTableName = "SalesOrders"
							strColName = "OrderXML1"
						Case 5
							strTableName = "SalesOrders"
							strColName = "OrderXML2"
					End Select

					'Drop existing indexes to allow dropping columns
					DropXMLIndexes(strTableName, strColName, True)

					strSQL = "ALTER TABLE " + strTableName + " DROP COLUMN " + strColName + "; "
					cmNwind.CommandText = strSQL
					strMsg += strSQL + vbCrLf
					Try
						cmNwind.ExecuteNonQuery()
					Catch exc As Exception
						strMsg += exc.Message + vbCrLf
					End Try
					If intCtr >= 4 Then
						'SalesOrders SchemaCollections have a corresponding name
						strColName = Replace(strColName, "Order", "SalesOrder")
					End If
					strSQL = "DROP XML SCHEMA COLLECTION " + strColName + "SchemaColl; "
					cmNwind.CommandText = strSQL
					strMsg += strSQL + vbCrLf
					Try
						cmNwind.ExecuteNonQuery()
					Catch exc As Exception
						strMsg += exc.Message + vbCrLf
					End Try
				Next
				If intStartTable = 4 Then
					btnOrderCols.Text = "Drop xml Columns"
				End If
			Else
				If cnNwind.State <> ConnectionState.Open Then
					cnNwind.Open()
				End If
				btnCustomerCols.Text = "Drop xml Columns"
				btnOrderCols.Text = "Drop xml Columns"
				'Set Customers table schema checkboxes
				TestSchemaCollections("Customer")
				chkCustXML1Index.Enabled = True
				chkCustXML2Index.Enabled = True
				'Set Orders table schema checkboxes
				TestSchemaCollections("Order")
				chkOrderXML1Index.Enabled = True
				chkOrderXML2Index.Enabled = True
				'Set Customers table index check box
				GetTableXmlIndexes("Customers")
				'Set Orders table index check boxes
				GetTableXmlIndexes("Orders")
			End If

			'Populate CustomerID and OrderID array lists
			strSQL = "SELECT CustomerID FROM Customers ORDER BY CustomerID"
			cmNwind.CommandText = strSQL
			Dim sdrCusts As SqlDataReader = cmNwind.ExecuteReader
			With sdrCusts
				If .HasRows Then
					While .Read
						alCustomerIDs.Add(.GetValue(0))
					End While
				End If
				.Close()
			End With
			strSQL = "SELECT OrderID FROM Orders ORDER BY OrderID"
			cmNwind.CommandText = strSQL
			Dim sdrOrders As SqlDataReader = cmNwind.ExecuteReader
			With sdrOrders
				If .HasRows Then
					While .Read
						alOrderIDs.Add(.GetValue(0))
					End While
				End If
				.Close()
			End With
            cnNwind.Close()
            'Set maximum number of rows for Orders
            txtMaxRows.Text = alOrderIDs.Count.ToString
			'Create the xml columns
			If My.Settings.DropOrdersXmlOnStart Then
				btnCustomerCols.PerformClick()
				btnOrderCols_Click(Nothing, Nothing)
			End If
			txtCustomerSQL.Text = "Click Fill CustomerXML1 or Fill CustomerXML2 to update the Customers table's xml column." + vbCrLf + _
			 "Mark a Schema check box to add an XmlSchemaCollection for XML instance validation." + vbCrLf + _
			 "Mark an Index check box to add primary and secondary indexes to the xml column."
			txtOrderSQL.Text = "Click Fill OrderXML1 or Fill OrderXML2 to update the Orders or SalesOrders table's xml column." + vbCrLf + _
			 "Mark a Schema check box to add an XmlSchemaCollection for XML instance validation." + vbCrLf + _
			 "Mark an Index check box to add a primary XML index and, optionally, one or more secondary indexes to the xml column."
			If chkUseSalesOrders.Enabled = True Then
				txtOrderSQL.Text += vbCrLf + "Mark the Use SalesOrders check box to substitute the SalesOrders " + _
				"table for the default Orders table."
			End If
			If blnInsertShowplans And Not blnShowPlanXML Then
				Dim strMsg As String = "You have specified the InsertShowplansInTable " + _
				"setting but not DisplayShowplanXML, which is required for this option. " + vbCrLf + vbCrLf + _
				"InsertShowplansInTable will be disabled for this session."
				MsgBox(strMsg, MsgBoxStyle.Information, "Required Application-Level Setting Missing")
				blnInsertShowplans = False
			End If
		Catch exc As SqlException
			Application.UseWaitCursor = False
			If exc.Message.Contains("Cannot open database") Then
				Dim strMsg As String = "The '" + strConn + "' connection string can't " + _
				 "open the 'Northwind' database. Open app.config and change the " + _
				 "'connectionString' attribute value to point to your SQL Server 2005 " + _
				 "instance with the required database."
				MsgBox(strMsg, MsgBoxStyle.Exclamation, "Failed to Open the Northwind Database")
			Else
				MsgBox(exc.Message, MsgBoxStyle.Exclamation, "Exception During Load Event")
			End If
		Catch exc As Exception
			Application.UseWaitCursor = False
			MsgBox(exc.Message)
		Finally
			cnNwind.Close()
			blnHasLoaded = True
			Application.UseWaitCursor = False
		End Try
	End Sub

	Private Function SalesOrdersSelection() As Integer
		Dim strSQL As String = "SELECT COUNT(OrderID) FROM SalesOrders; "
		cmNwind.CommandText = strSQL
		Try
			intSORecords = CInt(cmNwind.ExecuteScalar)
		Catch exc As Exception
			'ignore it
		End Try
		If intSORecords > 0 Then
			Try
				'Get SalesOrder data
				strSQL = "SELECT MIN(OrderID) FROM SalesOrders; "
				cmNwind.CommandText = strSQL
				intSOrderIDMin = CInt(cmNwind.ExecuteScalar)
				strSQL = "SELECT MAX(OrderID) FROM SalesOrders; "
				cmNwind.CommandText = strSQL
				intSOrderIDMax = CInt(cmNwind.ExecuteScalar)
				strSQL = "SELECT * FROM SalesOrders WHERE OrderID = " + intSOrderIDMin.ToString
				cmNwind.CommandText = strSQL
                Dim srOrder As SqlDataReader
                srOrder = cmNwind.ExecuteReader

				Dim intXMLCols As Integer
				With srOrder
					Dim intCol As Integer
					For intCol = 0 To .FieldCount - 1
						If .GetName(intCol) = "OrderXML1" Then
							intXMLCols += 1
						End If
						If .GetName(intCol) = "OrderXML2" Then
							intXMLCols += 1
						End If
					Next
				End With
                srOrder.Close()

				Dim strMsg As String = "Your SalesOrders table has " + _
				intSORecords.ToString("#,##0") + " rows and "
				If intXMLCols = 2 Then
					strMsg += "two xml columns. "
				ElseIf intXMLCols = 1 Then
					strMsg += "one xml column. "
				Else
					strMsg += "no xml columns. "
				End If
				strMsg += "Click Yes if you want to work with the SalesOrders table"
				If intXMLCols = 2 Then
					strMsg += " and retain their current content. "
				ElseIf intXMLCols = 1 Then
					strMsg += " and retain its current content. "
				Else
					strMsg += ". "
				End If
				strMsg += vbCrLf + vbCrLf
				If intXMLCols > 0 Then
					strMsg += "Click No to work with the SalesOrders table, drop the xml column(s), and start over."
					strMsg += vbCrLf + vbCrLf
				End If
				strMsg += "Click Cancel if you don't want to use the SalesOrders table with this project."
				strMsg += vbCrLf + vbCrLf + "The SalesOrders table is useful for determining query performance " + _
				 "improvment by adding xml column indexes. You can specify the number of xml column rows to populate " + _
				 "incrementally with documents." + vbCrLf + vbCrLf
				strMsg += "Note: Using a SalesOrders table with a large number of rows slows indexing or reindexing and might slow startup operations. " + _
				 "However, populating a large number of rows with XML documents aids in determining " + _
				 "the effect of xml primary and secondary indexes on XQuery performance." + vbCrLf + vbCrLf
				strMsg += "Open the project Properties window's Settings page to set user startup preferences."
				Dim intMsg As Integer
				If intXMLCols > 0 Then
					intMsg = MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNoCancel, "SalesOrders Table Options")
					If intMsg = MsgBoxResult.Yes Then
						Return 2
					ElseIf intMsg = MsgBoxResult.No Then
						strMsg = "Are you SURE you want to start over with empty OrderXML1 and OrderXML2 " + _
						 "columns of your SalesOrders table?" + vbCrLf + vbCrLf
						strMsg += "Click OK to start over or click Cancel to use the existing xml column content and settings. " + _
						vbCrLf + vbCrLf + "Note: Loading is likely to be delayed due to DBCC CLEANTABLE operations on SalesOrders."
						If MsgBox(strMsg, MsgBoxStyle.Critical Or MsgBoxStyle.OKCancel, "About to Drop and Recreate SalesOrder xml Columns") = MsgBoxResult.OK Then
							Return 1
						Else
							Return 2
						End If
					End If
				Else
					strMsg = Replace(strMsg, "Yes", "OK")
					intMsg = MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.OKCancel, "SalesOrders Table Options")
					If intMsg = MsgBoxResult.OK Then
						Return 1
					Else
						Return 0
					End If
				End If
			Catch exc As Exception
				'Don't use SalesOrders
				Return 0
			End Try
		Else
			Return 0
		End If
	End Function

	Private Sub TestSchemaCollections(ByVal strColName As String)
		'Test for existence of XML1 and XML1 SchemaCollections
		'Expects an open connection
		Dim intCtr As Integer
		Dim strSQL As String
		Try
			For intCtr = 1 To 2
				strSQL = "SELECT xml_schema_namespace(N'dbo',N'" + strColName + "XML1SchemaColl')"
				strSQL += ".query('/xs:schema[@targetNamespace=""http://www.northwind.com/schemas/" + strColName + """]')"
				If intCtr = 2 Then
					strSQL = Replace(strSQL, "XML1", "XML2")
				End If
				cmNwind.CommandText = strSQL
				blnBypassHandler = True
				Dim xrSchema As XmlReader = Nothing
				Try
					'Read the schema, if present
					xrSchema = cmNwind.ExecuteXmlReader
					'cnNwind.Close()
					If strColName = "Customer" Then
						If xrSchema Is Nothing Then
							If intCtr = 2 Then
								chkCustXML2Schema.Checked = False
							Else
								chkCustXML1Schema.Checked = False
							End If
						Else
							If intCtr = 2 Then
								chkCustXML2Schema.Checked = True
							Else
								chkCustXML1Schema.Checked = True
							End If
						End If
					Else
						If xrSchema Is Nothing Then
							If intCtr = 2 Then
								chkOrderXML2Schema.Checked = False
							Else
								chkOrderXML1Schema.Checked = False
							End If
						Else
							If intCtr = 2 Then
								chkOrderXML2Schema.Checked = True
							Else
								chkOrderXML1Schema.Checked = True
							End If
						End If
					End If
					xrSchema.Close()
				Catch exc As Exception
					chkOrderXML1Schema.Checked = False
				Finally
					blnBypassHandler = False
					If xrSchema IsNot Nothing Then
						xrSchema.Close()
					End If
				End Try
			Next intCtr
		Catch exc As Exception
			MsgBox(exc.Message, MsgBoxStyle.Exclamation, "TestSchemaCollections Exception")
		End Try
	End Sub