xmlcolumns.vb

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

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

Public Class xmlColumns
	Private cnData As SqlConnection
	Private cmData As SqlCommand
	Private strConn As String
	Private strIEFile As String = "\Program Files\Internet Explorer\Iexplore.exe"
	Private blnEnableIE As Boolean
	Private strXsdFile As String = Application.StartupPath + "\XmlSchema.xsd"
	Private strXmlFile As String = Application.StartupPath + "\XmlData.xml"
	Private strNS As String
	Private blnTyped As Boolean
	Private strXmlColName As String
	Private intXmlCol As Integer
	Private intXmlCols As Integer '= 2 for Northwind tables
	Private alColNames As ArrayList
	Private strSchemaName As String
	Private strDbName As String = "AdventureWorks"

	Private Sub XmlColumns_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
		Try
			tabXmlCols.TabPages(1).Visible = False
			tabXmlCols.TabPages(2).Visible = False
			tabXmlCols.TabPages(3).Visible = False
			If File.Exists(strIEFile) Then
				blnEnableIE = True
			End If
			'Set the connection and command
			strConn = My.Settings.AdventureWorksConnection
			If strDbName = "Northwind" Then
				strConn = strConn.Replace("AdventureWorks", "Northwind")
			End If
			cnData = New SqlConnection(strConn)
			'Test the connection
			cnData.Open()
			cnData.Close()
			cmData = New SqlCommand()
			btnGetAll.PerformClick()
		Catch exc As Exception
			Dim strMsg As String = "The '" + strConn + "' connection string can't " + _
			"open the 'AdventureWorks' 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 AdventureWorks Database")
		End Try
	End Sub

	Private Sub btnGetAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGetAll.Click
		'Simple display
		tabXmlCols.TabPages(0).Text = "All Tables with xml Columns"
        Application.DoEvents()
		blnTyped = False
		LoadColumnGrid()
		lblColsHelp.Text = "Select a row to display table rows in the second tab page."
	End Sub

	Private Sub btnGetTyped_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGetTyped.Click
		'Full display
		tabXmlCols.TabPages(0).Text = "Tables with Typed xml Columns"
        Application.DoEvents()
		blnTyped = True
		LoadColumnGrid()
		lblColsHelp.Text = "Select a row to display information on all tab pages."
	End Sub

	Private Sub LoadColumnGrid()
		'Populate the first tab page's DataGridView
		tabXmlCols.TabPages(1).Visible = False
		tabXmlCols.TabPages(2).Visible = False
		tabXmlCols.TabPages(3).Visible = False
		Dim strSQL As String = Nothing
		btnDataInIE.Enabled = False
		If blnTyped Then
			'Get schema, table, column, xml schema name, and namespace names
			With dgvXmlCols
				.Rows.Clear()
				.Columns(3).Visible = True
				.Columns(4).Visible = True
			End With
			strSQL = "SELECT sys.schemas.name AS SchemaName, " + _
			 "sys.tables.name AS TableName, sys.columns.name AS ColumnName, " + _
			 "sys.xml_schema_collections.name AS XmlSchemaName, " + _
			 "sys.xml_schema_namespaces.name AS XmlNamespace " + _
			 "FROM sys.schemas, sys.tables, sys.columns, sys.xml_schema_collections, sys.xml_schema_namespaces " + _
			 "WHERE sys.tables.schema_id = sys.schemas.schema_id " + _
			 "AND sys.tables.object_id = sys.columns.object_id " + _
			 "AND sys.xml_schema_collections.schema_id = sys.schemas.schema_id " + _
			 "AND sys.xml_schema_namespaces.xml_collection_id = sys.xml_schema_collections.xml_collection_id " + _
			 "AND sys.columns.system_type_id = 241 "
			'Another WHERE predicate is required to prevent a cartesian product
			'so a fixup is required when adding rows to the DataGridView
			strSQL += "ORDER BY SchemaName, TableName, ColumnName;"
		Else
			'Get schema, table, and column names only
			With dgvXmlCols
				.Rows.Clear()
				.Columns(3).Visible = False
				.Columns(4).Visible = False
			End With
			strSQL = "SELECT sys.schemas.name AS SchemaName, " + _
			 "sys.tables.name AS TableName, sys.columns.name AS ColumnName " + _
			 "FROM sys.schemas, sys.tables, sys.columns " + _
			 "WHERE sys.tables.schema_id = sys.schemas.schema_id " + _
			 "AND sys.tables.object_id = sys.columns.object_id " + _
			 "AND sys.columns.system_type_id = 241 " + _
			 "ORDER BY SchemaName, TableName, ColumnName;"
		End If
		cmData.Connection = cnData
		cmData.CommandText = strSQL
		cmData.CommandType = CommandType.Text
		cnData.Open()
		Dim sdrCols As SqlDataReader = cmData.ExecuteReader
		With sdrCols
			If .HasRows Then
				Dim objValues(.FieldCount - 1) As Object
				While .Read
					.GetValues(objValues)
					If strDbName = "Northwind" And blnTyped Then
						'Hack for cartesian schema query
						If (objValues(3).ToString.IndexOf(objValues(2).ToString) = 0 _
						 And Not objValues(1).ToString = "SalesOrders") _
						 OrElse (objValues(1).ToString = "SalesOrders" And _
						 objValues(3).ToString.IndexOf(objValues(2).ToString) = 5) Then
							dgvXmlCols.Rows.Add(objValues)
						End If
					ElseIf strDbName = "AdventureWorks" And blnTyped Then
						'Worse (tortured) hack for AdventureWorks
						If objValues(3).ToString.Contains(objValues(2).ToString) _
						 Or objValues(4).ToString.Contains(objValues(1).ToString) Then
							If Not (objValues(0).ToString = "Production" And _
							 objValues(2).ToString = "CatalogDescription" And _
							 objValues(4).ToString.Contains("Instructions") Or _
							 objValues(0).ToString = "Production" And _
							 objValues(2).ToString = "Instructions" And _
							 Not objValues(4).ToString.Contains("Instructions")) Then
								dgvXmlCols.Rows.Add(objValues)
							End If
						End If
					Else
						dgvXmlCols.Rows.Add(objValues)
					End If
				End While
			End If
		End With
		sdrCols.Close()
		cnData.Close()
	End Sub

	Private Sub dgvXmlCols_SelectionChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles dgvXmlCols.SelectionChanged
		'Populate the second tab page's DataGridView with table data
		With dgvXmlCols
            Application.DoEvents()
			Dim srcSel As DataGridViewSelectedRowCollection
			srcSel = .SelectedRows
			If srcSel.Count > 0 Then
				Me.Cursor = Cursors.WaitCursor
				Dim rowSel As DataGridViewRow = srcSel(0)
				tabXmlCols.TabPages(1).Text = rowSel.Cells(1).Value.ToString + " Table Data"
				tabXmlCols.TabPages(2).Text = "Selected Row xml Data"
				'Get the data for the selected table
				If blnTyped Then
					strSchemaName = rowSel.Cells(3).Value.ToString
				Else
					strSchemaName = ""
				End If
				Dim strSQL As String = "SELECT * FROM " + rowSel.Cells(0).Value.ToString + _
				 "." + rowSel.Cells(1).Value.ToString
				cmData.CommandText = strSQL
				cnData.Open()
				Dim sdrData As SqlDataReader = cmData.ExecuteReader
				strXmlColName = ""
				intXmlCol = -1
				Dim intRow As Integer
				Dim intMaxRows As Integer
				If chkLimitRows.Checked Then
					intMaxRows = Integer.Parse(txtMaxRows.Text)
					If intMaxRows = 0 Then
						intMaxRows = 1000
					End If
				Else
					intMaxRows = Int32.MaxValue
				End If
				With sdrData
					intXmlCols = 0
					alColNames = New ArrayList
					If .HasRows Then
						dgvData.Rows.Clear()
						dgvData.Columns.Clear()
						Dim intCol As Integer
						'Create the columns
						For intCol = 0 To .FieldCount - 1
							dgvData.Columns.Add(.GetName(intCol), .GetName(intCol))
							dgvData.Columns(intCol).DefaultCellStyle.WrapMode = DataGridViewTriState.False
							If .GetDataTypeName(intCol) = "xml" Then
								strXmlColName = .GetName(intCol)
								alColNames.Add(strXmlColName)
								intXmlCol = intCol
								intXmlCols += 1
							End If
						Next
						Dim objValues(.FieldCount - 1) As Object
						While .Read
							If (intXmlCol >= 0 AndAlso (chkXmlOnly.Checked And Not .IsDBNull(intXmlCol))) _
							 Or Not chkXmlOnly.Checked Then
								'rowguid columns throw an error
								.GetValues(objValues)
								dgvData.Rows.Add(objValues)
								intRow += 1
								If intRow > intMaxRows Then
									Exit While
								End If
							End If
						End While
						.Close()
						For intCol = 0 To dgvData.Columns.Count - 1
							If dgvData.Columns(intCol).Name = "rowguid" Then
								'Don't show rowguid columns
								dgvData.Columns(intCol).Visible = False
							End If
						Next
						If intXmlCols > 1 Then
							'intXmlCol is the last
							dgvData.Columns(intXmlCol).Width = 200
							dgvData.Columns(intXmlCol - 1).Width = 200
						Else
							If intXmlCol >= 0 Then
								dgvData.Columns(intXmlCol).Width = 200
							End If
						End If
						'Required to make scrollbar usuable for large number of rows
						dgvData.Sort(dgvData.Columns(0), System.ComponentModel.ListSortDirection.Descending)
						dgvData.Sort(dgvData.Columns(0), System.ComponentModel.ListSortDirection.Ascending)
					End If
					tabXmlCols.TabPages(1).Visible = True
				End With

				If blnTyped Then
					tabXmlCols.TabPages(3).Text = rowSel.Cells(2).Value.ToString + " Column xml Schema"
					'Get the schema for the selected namespace
					strSQL = "SELECT xml_schema_namespace(N'" + _
					  rowSel.Cells(0).Value.ToString + "', N'" + rowSel.Cells(3).Value.ToString + "')"
					strNS = rowSel.Cells(4).Value.ToString
					If strNS.Length > 0 Then
						strSQL += ".query('/xs:schema[@targetNamespace=""" + strNS + """]')"
					End If
					cmData.CommandText = strSQL

					'Read the schema and save to a file with an XmlTextWriter
					Dim xrSchema As XmlReader = cmData.ExecuteXmlReader
					Dim xtwSchema As New XmlTextWriter(strXsdFile, Encoding.UTF8)
					xtwSchema.Formatting = Formatting.Indented
					xrSchema.MoveToContent()
					xtwSchema.WriteNode(xrSchema, False)
					xtwSchema.Flush()
					xtwSchema.Close()
					xrSchema.Close()

					'Display the schema in the text box
					txtXmlSchema.Text = My.Computer.FileSystem.ReadAllText(strXsdFile)
					lblSchema.Text = strDbName + "." + rowSel.Cells(0).Value.ToString + _
					 "." + rowSel.Cells(1).Value.ToString + "." + rowSel.Cells(2).Value.ToString
					If strNS.Length > 0 Then
						Dim strNSAbbr As String = strNS.Substring(strNS.LastIndexOf("/"c))
						lblSchema.Text += ".Namespace: ..." + strNSAbbr
					End If
					btnSchemaInIE.Enabled = True
					If strDbName = "AdventureWorks" Then
						btnSourceSchemaInIE.Enabled = True
					Else
						btnSourceSchemaInIE.Enabled = False
					End If
					tabXmlCols.TabPages(3).Visible = True
				Else
					btnSchemaInIE.Enabled = False
					btnSourceSchemaInIE.Enabled = False
					tabXmlCols.TabPages(3).Visible = False
				End If
			cnData.Close()
			Me.Cursor = Cursors.Default
			End If
		End With
	End Sub

	Private Sub btnSchemaInIE_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSchemaInIE.Click
		Dim strShell As String = """" + strIEFile + """ " + strXsdFile
		Shell(strShell, AppWinStyle.NormalFocus)
	End Sub

	Private Sub btnSourceSchemaInIE_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSourceSchemaInIE.Click
		Dim strShell As String = """" + strIEFile + """ " + strNS + strNS.Substring(strNS.LastIndexOf("/"c)) + ".xsd"
		Shell(strShell, AppWinStyle.NormalFocus)
	End Sub

	Private Sub dgvData_DataError(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewDataErrorEventArgs) Handles dgvData.DataError
		'Handle errors with rowguid columns
		e.ThrowException = False
	End Sub

	Private Sub dgvData_SelectionChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles dgvData.SelectionChanged
		If intXmlCol >= 0 Then
			'Populate the third tab page's text box with XML data
			With dgvData
                Application.DoEvents()
				Dim srcSel As DataGridViewSelectedRowCollection
				srcSel = .SelectedRows
				If srcSel.Count > 0 Then
					Dim rowSel As DataGridViewRow = srcSel(0)
					If intXmlCols > 1 And blnTyped And strDbName = "Northwind" Then
						'Northwind-specific code -- two xml columns (or more)
						Dim intCtr As Integer
						For intCtr = 0 To alColNames.Count - 1
							If strSchemaName.Contains(alColNames(intCtr).ToString) Then
								strXmlColName = alColNames(intCtr).ToString
								intXmlCol = intXmlCol - intXmlCols + (intCtr + 1)
								Exit For
							End If
						Next
					End If
					tabXmlCols.TabPages(2).Text = strXmlColName + " Row xml Data"
					Dim strXmlData As String = rowSel.Cells(intXmlCol).Value.ToString
					My.Computer.FileSystem.WriteAllText(strXmlFile, strXmlData, False, Encoding.UTF8)
					strXmlData = Replace(strXmlData, "><", ">" + vbCrLf + "<")
					txtXmlData.Text = strXmlData
					btnDataInIE.Enabled = True
					tabXmlCols.TabPages(2).Visible = True
				Else
					btnDataInIE.Enabled = False
					tabXmlCols.TabPages(2).Visible = False
				End If
			End With
		End If
	End Sub

	Private Sub btnDataInIE_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDataInIE.Click
		Dim strShell As String = """" + strIEFile + """ " + strXmlFile
		Shell(strShell, AppWinStyle.NormalFocus)
	End Sub

	Private Sub btnDatabase_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDatabase.Click
		'Toggle between AdventureWorks and Northwind databases
		btnDatabase.Text = strDbName
		If strDbName = "AdventureWorks" Then
			strDbName = "Northwind"
			Me.Text = Replace(Me.Text, "AdventureWorks", "Northwind")
			lblSchema.Text = Replace(lblSchema.Text, "AdventureWorks", "Northwind")
			btnSourceSchemaInIE.Enabled = False
		Else
			strDbName = "AdventureWorks"
			Me.Text = Replace(Me.Text, "Northwind", "AdventureWorks")
			lblSchema.Text = Replace(lblSchema.Text, "Northwind", "AdventureWorks")
			btnSourceSchemaInIE.Enabled = True
		End If
		'Clear prior settings and tab text
		dgvData.Rows.Clear()
		dgvXmlCols.Rows.Clear()
		txtXmlData.Text = ""
		txtXmlSchema.Text = ""
		tabXmlCols.TabPages(1).Text = "Selected Table Data"
		tabXmlCols.TabPages(2).Text = "Selected xml Data"
		'Reload the data
		XmlColumns_Load(Nothing, Nothing)
	End Sub
End Class