customersxml.vb

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

Imports System.Data.Sql
Imports System.Data.SqlClient
Imports System.Xml
Imports System.Text
Partial Public Class NwXmlCols
	'Procedures and function for the Customers Table Page

	Private Sub btnCustomerCols_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCustomerCols.Click
		Try
			Dim strSQL As String = "ALTER TABLE Customers "
			Dim blnCreate As Boolean
			If btnCustomerCols.Text.IndexOf("dd") > 0 Then
				strSQL += "ADD CustomerXML1 xml NULL, CustomerXML2 xml NULL; "
				blnCreate = True
			Else
				DropXMLIndexes("Customers", "CustomerXML1", False)
				DropXMLIndexes("Customers", "CustomerXML2", False)
				strSQL += "DROP COLUMN CustomerXML1, CustomerXML2; "
			End If
			txtCustomerSQL.Text = strSQL
			cmNwind.CommandText = strSQL
			cnNwind.Open()
			Dim intRetVal As Integer = cmNwind.ExecuteNonQuery
			If intRetVal = -1 Then
				'txtCustomerSQL.Text = ""
				txtCustomerData.Text = ""
				If blnCreate Then
					CustomersControlState(True)
					btnCustomerCols.Text = "&Drop xml Columns"
				Else
					CustomersControlState(False)
					btnCustomerCols.Text = "&Add xml Columns"
				End If
			Else
				'Error
			End If
			cnNwind.Close()
		Catch exc As Exception
			txtCustomerSQL.Text = exc.Message
			If exc.Message.Contains("does not exist") Then
				btnCustomerCols.Text = "&Add xml Columns"
				txtCustomerSQL.Text += vbCrLf + vbCrLf + "Click the Add xml Columns button."
			End If
		Finally
			cnNwind.Close()
		End Try
	End Sub

	Private Sub CustomersControlState(ByVal blnEnabled As Boolean)
		btnFillCustomerXML1.Enabled = blnEnabled
		btnFillCustomerXML2.Enabled = blnEnabled
		chkCustXML1Schema.Enabled = blnEnabled
		chkCustXML2Schema.Enabled = blnEnabled
	End Sub

	Private Sub btnFillCustomerXML1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFillCustomerXML1.Click
		ClearTimingData()
		Me.Cursor = Cursors.WaitCursor
		Dim strSQL As String = "DECLARE @CustomerXML xml " + _
		 "SET @CustomerXML = (SELECT CustomerID, ContactName, ContactTitle, CompanyName, Address, City, Region, PostalCode, Country, Phone, Fax " + _
		 "FROM Customers AS Customer WHERE CustomerID = @CustomerID FOR XML AUTO, ELEMENTS, TYPE) " + _
		 "UPDATE Customers SET CustomerXML1 = @CustomerXML WHERE CustomerID = @CustomerID; "
		txtCustomerSQL.Text = strSQL
        Application.DoEvents()
		intRows = UpdateCustomersXML(strSQL, "CustomerXML1")
		Me.Cursor = Cursors.Default
		chkCustXML1Index.Enabled = True
	End Sub

	Private Sub btnFillCustomerXML2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFillCustomerXML2.Click
		ClearTimingData()
		Me.Cursor = Cursors.WaitCursor
		Dim strSQL As String = "SELECT CustomerID, CompanyName, ContactName, " + _
		 "ContactTitle, Address, City, Region, PostalCode, Country, Phone, Fax" + vbCrLf + _
		 "FROM Customers WHERE CustomerID = @CustomerID; "
		txtCustomerSQL.Text = strSQL
        Application.DoEvents()
		intRows = UpdateCustomersXML("", "CustomerXML2")
		Me.Cursor = Cursors.Default
		chkCustXML2Index.Enabled = True
	End Sub

	Public Function UpdateCustomersXML(ByVal strSQL As String, ByVal strColName As String) As Integer
		'Populate the specified Customers column
		intRows = 0
		pbFillColumn.Value = 0
		pbFillColumn.Maximum = alCustomerIDs.Count
		ClearTimingData()
		objTimer = New Stopwatch
		objTimer.Start()
		With cmNwind
			.Parameters.Clear()
			.Parameters.AddWithValue("@CustomerID", alCustomerIDs(0))
			.CommandText = strSQL
			cnNwind.Open()
			Dim intRow As Integer
			Dim strCustomerID As String
			For intRow = 0 To alCustomerIDs.Count - 1
				strCustomerID = alCustomerIDs(intRow).ToString
				.Parameters(0).Value = alCustomerIDs(intRow)
				If strColName = "CustomerXML2" Then
					strSQL = "UPDATE Customers SET CustomerXML2 = N'" + _
					 CreateCustomerXML2Doc(strCustomerID) + _
					 "' WHERE CustomerID = @CustomerID; "
					.CommandText = strSQL
					If intRow = 0 Then
						txtCustomerSQL.Text += vbCrLf + strSQL
						txtCustomerSQL.Text = Replace(txtCustomerSQL.Text, "@CustomerID", "'ALFKI'")
					End If
				End If
				Try
					intRows += cmNwind.ExecuteNonQuery
					pbFillColumn.Value = intRows
				Catch exc As Exception
					txtCustomerData.Text = exc.Message + vbCrLf
				End Try
			Next
			.Parameters.Clear()
		End With
		cnNwind.Close()
		dblTime = objTimer.ElapsedTime
		objTimer.Done()
		txtTime.Text = dblTime.ToString("0.000")
		txtCustomerData.Text = SaveAndDisplayData("Customers", strColName, 0)
		lngBytes = txtCustomerData.Text.Length * intRows
		If chkBytes.Checked Then
			Dim dblKB As Double = lngBytes / 1000
			txtRows.Text = dblKB.ToString("#,##0.0")
			txtRowsPerSec.Text = (dblKB / dblTime).ToString("#0.0")
		Else
			txtRows.Text = intRows.ToString
			txtRowsPerSec.Text = (intRows / dblTime).ToString("#0.0")
		End If
		Return intRows
	End Function

	Private Function CreateCustomerXML2Doc(ByVal strCustomerID As String) As String
		Dim strSQL As String = "SELECT CustomerID, CompanyName, ContactName, " + _
		 "ContactTitle, Address, City, Region, PostalCode, Country, Phone, Fax" + vbCrLf + _
		 "FROM Customers WHERE CustomerID = @CustomerID; "
		Dim strNS As String = "http://www.northwind.com/schemas/Customer"
        'Dim sdrCust As SqlRecord
        Dim sdrCust As SqlDataReader
		Try
			With cmNwind
				.CommandText = strSQL
                sdrCust = .ExecuteReader
			End With
		Catch exc As Exception
			Return "Error executing query"
        End Try
        If sdrCust.HasRows Then
            sdrCust.Read()
        Else
            sdrCust.Close()
            Return "Customers query returned no rows"
        End If
        Dim xwSettings As New XmlWriterSettings
        Dim sbXML As New StringBuilder()
        With xwSettings
            .Encoding = Encoding.Unicode
            .Indent = True
            .IndentChars = ("  ")
            .OmitXmlDeclaration = False
            .ConformanceLevel = ConformanceLevel.Document
        End With
        Dim xwCust As XmlWriter
        xwCust = XmlWriter.Create(sbXML, xwSettings)
        With xwCust
            .WriteStartElement("nwc", "Customer", strNS)
            .WriteElementString("nwc", "CustomerID", strNS, sdrCust.GetString(0))
            .WriteElementString("nwc", "CompanyName", strNS, sdrCust.GetString(1))
            .WriteElementString("nwc", "ContactName", strNS, sdrCust.GetString(2))
            .WriteElementString("nwc", "ContactTitle", strNS, sdrCust.GetString(3))
            .WriteElementString("nwc", "Address", strNS, sdrCust.GetString(4))
            .WriteElementString("nwc", "City", strNS, sdrCust.GetString(5))
            If Not sdrCust.IsDBNull(6) Then
                .WriteElementString("nwc", "Region", strNS, sdrCust.GetString(6))
            End If
            If Not sdrCust.IsDBNull(7) Then
                .WriteElementString("nwc", "PostalCode", strNS, sdrCust.GetString(7))
            End If
            .WriteElementString("nwc", "Country", strNS, sdrCust.GetString(8))
            .WriteElementString("nwc", "Phone", strNS, sdrCust.GetString(9))
            If Not sdrCust.IsDBNull(10) Then
                .WriteElementString("nwc", "Fax", strNS, sdrCust.GetString(10))
            End If
            .WriteEndElement()
            .Flush()
            .Close()
        End With
        sdrCust.Close()
        Dim strCustXML1 As String = sbXML.ToString
        lngBytes += strCustXML1.Length
        'Fixup for '
        Return Replace(strCustXML1, "'", "''")
    End Function

	Private Sub chkCustXML1Schema_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkCustXML1Schema.CheckedChanged
		'Create the SchemaCollection
		If blnBypassHandler Then
			Return
		End If
		txtCustomerSQL.Text = ""
		txtCustomerData.Text = ""
		DropXMLIndexes("Customers", "CustomerXML1", False)
		If chkCustXML1Schema.Checked Then
			txtCustomerSQL.Text = CreateXmlSchemaCollection("Customers", "CustomerXML1")
			txtCustomerData.Text = ReadXmlSchemaCollection("CustomerXML1", "")
		Else
			txtCustomerSQL.Text = DropXmlSchemaCollection("Customers", "CustomerXML1")
		End If
		If chkCustXML1Index.Checked Then
			'Recreate the indexes
			CreateXMLIndexes("Customers", "CustomerXML1")
		End If
		chkCustXML1Index.Enabled = False
	End Sub

	Private Sub chkCustXML2Schema_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkCustXML2Schema.CheckedChanged
		If blnBypassHandler Then
			Return
		End If
		'Create the SchemaCollection
		txtCustomerSQL.Text = ""
		txtCustomerData.Text = ""
		DropXMLIndexes("Customers", "CustomerXML2", False)
		If chkCustXML2Schema.Checked Then
			txtCustomerSQL.Text = CreateXmlSchemaCollection("Customers", "CustomerXML2")
			txtCustomerData.Text = ReadXmlSchemaCollection("CustomerXML2", "")
		Else
			txtCustomerSQL.Text = DropXmlSchemaCollection("Customers", "CustomerXML2")
		End If
		If chkCustXML2Index.Checked Then
			'Recreate the indexes
			CreateXMLIndexes("Customers", "CustomerXML2")
		End If
		chkCustXML2Index.Enabled = False
	End Sub

	Private Sub chkCustXML1Index_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkCustXML1Index.CheckedChanged
		If blnBypassHandler Then
			Return
		End If
		Me.Cursor = Cursors.WaitCursor
		txtCustomerSQL.Text = ""
		txtCustomerData.Text = ""
		If chkCustXML1Index.Checked Then
			txtCustomerSQL.Text = CreateXMLIndexes("Customers", "CustomerXML1")
			txtCustomerData.Text = GetXMLIndexStats("Customers", "CustomersXML1")
		Else
			txtCustomerSQL.Text = DropXMLIndexes("Customers", "CustomerXML1", False)
		End If
		Me.Cursor = Cursors.Default
	End Sub

	Private Sub chkCustXML2Index_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkCustXML2Index.CheckedChanged
		If blnBypassHandler Then
			Return
		End If
		Me.Cursor = Cursors.WaitCursor
		txtCustomerSQL.Text = ""
		txtCustomerData.Text = ""
		If chkCustXML2Index.Checked Then
			txtCustomerSQL.Text = CreateXMLIndexes("Customers", "CustomerXML2")
			txtCustomerData.Text = GetXMLIndexStats("Customers", "CustomersXML2")
		Else
			txtCustomerSQL.Text = DropXMLIndexes("Customers", "CustomerXML2", False)
		End If
		Me.Cursor = Cursors.Default
	End Sub
End Class