nwxmlcols.vb

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

	Private Function GetXQueryResult(ByVal strXQL As String, ByVal strRootName As String, ByVal intMaxRows As Integer, ByVal blnSqlXml As Boolean, ByVal blnOpenConn As Boolean, ByVal blnIsRandom As Boolean) As String
		'Return the result to populate the Data text box
		Dim xrResult As XmlReader
		Dim xwSettings As XmlWriterSettings
		Dim xwResult As XmlWriter = Nothing
		Dim blnNodes As Boolean
		Dim intDGVRows As Integer
		Dim blnWasSqlXml As Boolean = blnSqlXml
		sbXML = New StringBuilder()
		intRows = 0
		lngBytes = 0
		dblTime = 0
		If Not blnIsRandom Then
			ClearTimingData()
			xwSettings = New XmlWriterSettings
			With xwSettings
				.Encoding = Encoding.Unicode
				.Indent = True
				.IndentChars = ("  ")
				.OmitXmlDeclaration = False
				.ConformanceLevel = ConformanceLevel.Document
			End With
			'Create an XmlWriter to format the result
			xwResult = XmlWriter.Create(sbXML, xwSettings)
			'High-resolution objTimer
			objTimer = New Stopwatch
			pbFillColumn.Maximum = intMaxRows
			pbFillColumn.Value = 0
            Application.DoEvents()
		End If
		Try
			txtCustsXQResult.Text = ""
			cmNwind.CommandText = strXQL
			If blnOpenConn Then
				'Don't open/close connection for multiple requests
				cnNwind.Open()
			End If
			Dim sdrData As SqlDataReader
			If blnIncludeReader And Not blnIsRandom Then
				objTimer.Start()
			End If
			sdrData = cmNwind.ExecuteReader
			With sdrData
				If .HasRows Then
					If Not blnIsRandom Then
						'Don't include SqlConnection or SqlDataReader opening time
						'Random IDs has its own timer
						If strXQL.Contains(".nodes") Then
							'Capability to display Nodes result sets was added after
							'adding DataGridView for Showplan results
							blnSqlXml = False
							blnNodes = True
							'Clear the grid
							With dgvShowPlan
								.Rows.Clear()
								.Columns.Clear()
								Dim intCol As Integer
								For intCol = 0 To sdrData.FieldCount - 1
									.Columns.Add(sdrData.GetName(intCol), sdrData.GetName(intCol))
									.Columns(intCol).DefaultCellStyle.WrapMode = DataGridViewTriState.False
									.Columns(intCol).DefaultCellStyle.NullValue = ""
								Next
							End With
						End If
						If Not blnIncludeReader Then
							'Start timing after opening sdrDR data
							objTimer.Start()
						End If
					End If

					Dim xmlData As SqlXml
					If blnSqlXml And Not blnIsRandom Then
						'Add the root element to the XmlWriter
						xwResult.WriteStartElement(strRootName)
					End If
					While .Read
						If blnSqlXml Then
							xmlData = .GetSqlXml(0)
							If blnIsRandom Then
								If .GetValue(0).ToString.Length > 0 Then
									If blnShowLast AndAlso intRows = intMaxRows - 1 Then
										sbXML.Append(.GetValue(0).ToString)
									End If
								Else
									intEmptyRows += 1
									If intRows > 0 Then
										intRows -= 1
									End If
								End If
							Else
								'Add child elements to the XmlWriter
								xrResult = xmlData.CreateReader
								xrResult.MoveToContent()
								xwResult.WriteNode(xrResult, False)
							End If
						ElseIf blnNodes Then
							'Fill the DataGridView
							Dim objNodes(.FieldCount - 1) As Object
							.GetValues(objNodes)
							dgvShowPlan.Rows.Add(objNodes)
							If dgvShowPlan.RowCount <> intRows + 1 Then
								Stop
							End If
							intDGVRows += 1
						Else
							'Dim strTest As String = .GetValue(0).ToString
							If blnIsRandom Then
								If .GetValue(0).ToString.Length > 0 Then
									If blnShowLast AndAlso intRows = intMaxRows - 1 Then
										sbXML.Append(.GetValue(0).ToString)
									Else
										intEmptyRows += 1
										If intRows > 0 Then
											intRows -= 1
										End If
									End If
								End If
							Else
								If .GetValue(0).ToString.Length > 0 Then
									'Get the value directly (no formatting)
									sbXML.Append(.GetValue(0).ToString)
									intEmptyRows += 1
								End If
							End If
						End If
						If (Not blnIsRandom) AndAlso intRows Mod 50 = 0 Then
							'Display every 50 rows
							pbFillColumn.Value = intRows
                            Application.DoEvents()
						End If
						If intRows >= intMaxRows Then
							'Limit for SalesOrders table (for safety)
							Exit While
						End If
						intRows += 1
					End While
					If blnSqlXml And Not blnIsRandom Then
						'Add the end element 
						xwResult.WriteEndElement()
						xwResult.Flush()
						xwResult.Close()
					End If
				Else
					sbXML.Append("XQuery expression returned no rows. ")
				End If
				'Closing the SqlDataReader here can add several seconds
				'for a SalesOrders table with many empty xml columns at the end
				'SqlCommand.Cancel doesn't appear to work in this case,
				'so the reader is closed after the time measurement
				'cmNwind.Cancel()
				'.Close()
			End With
			If blnIsRandom Then
				'Relocated SqlDataReader.Close for accurate timing with empty xml columns
				If Not sdrData.IsClosed Then
					sdrData.Close()
				End If
				'For count
				If intRows = 0 Then
					intRows = 1
				End If
				If blnShowLast Then
					txtOrdersXQResult.Text += sbXML.Replace("><", ">" + vbCrLf + "<").ToString + vbCrLf + vbCrLf
				End If
				Return intRows.ToString
			End If

			dblTime = objTimer.ElapsedTime
			pbFillColumn.Value = pbFillColumn.Maximum
			objTimer.Done()
			lngBytes = sbXML.Length
			If dblTime < 1 Then
				'Microseconds
				txtTime.Text = dblTime.ToString("0.000000")
			Else
				'Milliseconds
				txtTime.Text = dblTime.ToString("0.000")
			End If
			If blnNodes Then
				With dgvShowPlan
					'Required to make scrollbars access more than 6 rows
					If strXQL.Contains("ORDER BY") And strXQL.Contains("DESC") Then
						.Sort(.Columns(0), System.ComponentModel.ListSortDirection.Ascending)
						.Sort(.Columns(0), System.ComponentModel.ListSortDirection.Descending)
					Else
						.Sort(.Columns(0), System.ComponentModel.ListSortDirection.Descending)
						.Sort(.Columns(0), System.ComponentModel.ListSortDirection.Ascending)
					End If
					'Show the DataGridView
					.Visible = True
					chkBytes.Checked = False
				End With
			End If
			If chkBytes.Checked Then
				Dim dblKB As Double
				dblKB = lngBytes / 1000
				If dblKB > 1.0 Then
					txtRows.Text = dblKB.ToString("#0.0")
				Else
					txtRows.Text = dblKB.ToString("0.000")
				End If
				txtRowsPerSec.Text = (dblKB / dblTime).ToString("#0.0")
			Else
				txtRows.Text = intRows.ToString
				txtRowsPerSec.Text = (intRows / dblTime).ToString("#,##0.00")
			End If
			'Relocated SqlDataReader.Close for accurate timing
			If Not sdrData.IsClosed Then
				sdrData.Close()
			End If
			If blnOpenConn Then
				cnNwind.Close()
			End If
			If Not blnSqlXml Then
				sbXML.Replace("><", ">" + vbCrLf + "<")
			End If
			If sbXML.Length > 1000000 Then
				'Limit text returned to textbox to 1 MB
				sbXML.Length = 1000000
			End If
			Return sbXML.ToString
		Catch exc As Exception
			If exc.Message.Contains("Object reference not set") Then
				Return "XQuery expression returned NULL."
			Else
				Return exc.Message
			End If
		Finally
			If blnOpenConn Then
				cnNwind.Close()
			End If
		End Try
	End Function

	Private Function SaveAndDisplayData(ByVal strTableName As String, ByVal strColName As String, ByVal intOrderID As Integer) As String
		Try
			'Display the last row formatted
			Dim strXmlFile As String = Application.StartupPath + "\" + strColName + ".xml"
			Dim strSQL As String = "SELECT " + strColName + " FROM " + strTableName
			If intOrderID > 0 Then
				strSQL += " WHERE OrderID = " + intOrderID.ToString + "; "
			Else
				If strColName.Contains("Order") Then
                    strSQL += " WHERE OrderID = " + alOrderIDs(alOrderIDs.Count - 1).ToString + "; "
                Else
                    strSQL += " WHERE CustomerID = '" + alCustomerIDs(alCustomerIDs.Count - 1).ToString + "'; "
                End If
			End If
			cmNwind.CommandText = strSQL
			cnNwind.Open()
			Dim xrData As XmlReader = cmNwind.ExecuteXmlReader
			'Old style with an XmlTextWriter
			Dim xtwData As New XmlTextWriter(strXmlFile, Encoding.Unicode)
			xtwData.Formatting = Formatting.Indented
			xrData.MoveToContent()
			xtwData.WriteNode(xrData, False)
			xtwData.Flush()
			xtwData.Close()
			xrData.Close()
			cnNwind.Close()
			If File.Exists(strXmlFile) Then
                Dim strXML As String = File.ReadAllText(strXmlFile)
				If strXML.Length = 0 Then
					Return "Can't find OrderID " + (intOrderID + 1).ToString + _
					 ". Use the FillSalesOrders project to add more SalesOrder table rows."
				Else
					Return strXML
				End If
			Else
				Return "Can't find '" + strXmlFile + "' file."
			End If
		Catch exc As Exception
			Return "Error: " + exc.Message
		Finally
			cnNwind.Close()
		End Try
	End Function

	Private Function CreateXmlSchemaCollection(ByVal strTableName As String, ByVal strColName As String) As String
		'Create a SchemaCollection from local .xsd file(s)
		txtCustomerSQL.Text = ""
		txtCustomerData.Text = ""
		Try
			Dim strSQL As String = Nothing
			'Use the same schema for OrderXML? and SalesOrdersXML?
			Dim strXsdFile As String = Application.StartupPath + "\" + strColName + ".xsd"
			If File.Exists(strXsdFile) Then
				Dim strSO As String = Nothing
				If blnSalesOrders Then
					strSO = "Sales"
				End If
                Dim strSchema As String = File.ReadAllText(strXsdFile)
				DropXMLIndexes(strTableName, strColName, False)
				strSQL = "ALTER TABLE " + strTableName + " DROP COLUMN " + strColName + "; " + vbCrLf
				strSQL += "CREATE XML SCHEMA COLLECTION " + strSO + strColName + "SchemaColl " + vbCrLf
				strSQL += "AS N'" + strSchema + "'; " + vbCrLf
				strSQL += "ALTER TABLE " + strTableName + " ADD " + strColName + " xml " + _
				 "(DOCUMENT " + strSO + strColName + "SchemaColl) NULL; "
				strSQL = Replace(strSQL, ControlChars.Tab, "  ")
				cmNwind.CommandText = strSQL
				If cnNwind.State <> ConnectionState.Open Then
					cnNwind.Open()
				End If
				If cmNwind.ExecuteNonQuery = -1 Then
					cnNwind.Close()
					Return "-- Click Fill " + strColName + " to repopulate the column" + vbCrLf + strSQL
				Else
					cnNwind.Close()
					Return "Error"
				End If
			Else
				Return "File '" + strXsdFile + "' is missing."
			End If
		Catch exc As Exception
			Return exc.Message
		Finally
			cnNwind.Close()
		End Try
	End Function

	Private Function DropXmlSchemaCollection(ByVal strTableName As String, ByVal strColName As String) As String
		Try
			Dim strSO As String = Nothing
			If blnSalesOrders Then
				strSO = "Sales"
			End If
			txtOrderData.Text = ""
			DropXMLIndexes(strTableName, strColName, False)
			Dim strMsg As String = Nothing
			'Invoke commands separately to avoid problems if column is missing
			Dim strSQL1 As String = "ALTER TABLE " + strTableName + " DROP COLUMN " + strColName + "; "
			Dim strSQL2 As String = "DROP XML SCHEMA COLLECTION " + strSO + strColName + "SchemaColl; "
			Dim strSQL3 As String = "ALTER TABLE " + strTableName + " ADD " + strColName + " xml NULL;"
			cnNwind.Open()
			Dim intCtr As Integer
			For intCtr = 1 To 3
				If intCtr = 1 Then
					cmNwind.CommandText = strSQL1
					strMsg += strSQL1
				ElseIf intCtr = 2 Then
					cmNwind.CommandText = strSQL2
					strMsg += strSQL2
				ElseIf intCtr = 3 Then
					cmNwind.CommandText = strSQL3
					strMsg += strSQL3
				End If
				strMsg += vbCrLf
				Try
					cmNwind.ExecuteNonQuery()
				Catch ex As Exception
					strMsg += ex.Message + vbCrLf
				End Try
			Next intCtr
			cnNwind.Close()
			Return "-- Click Fill " + strColName + " to repopulate the column" + vbCrLf + strMsg
		Catch exc As Exception
			Return exc.Message
		Finally
			cnNwind.Close()
		End Try
	End Function

	Private Function ReadXmlSchemaCollection(ByVal strColName As String, ByVal strNamespace As String) As String
		'Read the XML SchemaCollection with an XmlReader and format with an XmlTextWriter
		Try
			Dim strSQL As String = "SELECT xml_schema_namespace(N'dbo',N'" + strColName + "SchemaColl')"
			If strNamespace.Length > 0 Then
				strSQL += ".query('/xs:schema[@targetNamespace=""" + strNamespace + """]')"
			End If
			cmNwind.CommandText = strSQL
			cnNwind.Open()
			'Read the schema and save to a file with an XmlTextWriter
			Dim xrSchema As XmlReader = cmNwind.ExecuteXmlReader
			cnNwind.Close()
			Dim strXsdFile As String = Application.StartupPath + "\" + strColName + "SchemaColl.xsd"
			Dim xtwSchema As New XmlTextWriter(strXsdFile, Encoding.Unicode)
			xtwSchema.Formatting = Formatting.Indented
			xrSchema.MoveToContent()
			xtwSchema.WriteNode(xrSchema, False)
			xtwSchema.Flush()
			xtwSchema.Close()
			xrSchema.Close()
			'temporary
			If File.Exists(strXsdFile) Then
                Return File.ReadAllText(strXsdFile)
			Else
				Return strSQL + vbCrLf + " did not find a schema."
			End If
		Catch exc As Exception
			Return exc.Message
		Finally
			cnNwind.Close()
		End Try
	End Function


	Private Function CreateXMLIndexes(ByVal strTableName As String, ByVal strColName As String) As String
		'Create all four XML indexes
		If blnSalesOrders Then
			'Prevent duplicate index names
			strColName = Replace(strColName, "Order", "SalesOrder")
		End If
		ClearTimingData()
		objTimer = New Stopwatch
		Try