customersxquery.vb

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

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

Partial Public Class NwXmlCols
	'Customers XQuery examples
	Private strXQuery As String
	Private strModify As String
	Private strClick As String = vbCrLf + vbCrLf + _
	 "-- Edit the XQuery expression to return the specified data or documents" + vbCrLf + _
	 "-- Click Execute XQuery to display the result"
	Private strNoEdit As String = vbCrLf + vbCrLf + _
	 "-- This sample query isn't editable" + vbCrLf + _
	 "-- Click Execute XQuery to display the result"
	'Maintain state of modify buttons
	Private blnInsertFax1 As Boolean
	Private blnModifyFax1 As Boolean
	Private blnDeleteFax1 As Boolean
	Private blnInsertFax2 As Boolean
	Private blnModifyFax2 As Boolean
	Private blnDeleteFax2 As Boolean
	Private strCustsXQuery As String

	Private Sub rbFindByCustID_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbFindByCustID.CheckedChanged
		If rbFindByCustID.Checked Then
			strXQuery = "SELECT CustomerXML1.query('(/Customer[/Customer/CustomerID=""WOLZA""])') " + vbCrLf + _
			 " FROM Customers;"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
			End If
			Dim strPrefix As String = "-- Uses the xml.query method to return a specified Customer document" + vbCrLf + vbCrLf
			txtCustsXQuery.Text = strPrefix + strXQuery + strClick
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			chkUseSqlXml.Checked = False
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = txtCustsXQuery.Text
		Else
			chkUseSqlXml.Checked = True
		End If
	End Sub

	Private Sub rbLastCustByValue_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbLastCustByValue.CheckedChanged
		If rbLastCustByValue.Checked Then
			chkUseSqlXml.Checked = False
			strXQuery = "SELECT CompanyName FROM Customers WHERE " + _
			  "CustomerXML1.value('(/Customer/CustomerID)[1]', 'nvarchar(5)') = 'WOLZA';"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
			End If
			Dim strPrefix As String = "-- Uses the xml.value method to return an SqlString value " + vbCrLf + _
			   "-- for use as a T-SQL variable value as a WHERE constraint or in a JOIN clause" + vbCrLf + vbCrLf
			txtCustsXQuery.Text = strPrefix + strXQuery + strClick
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = txtCustsXQuery.Text
		Else
			chkUseSqlXml.Checked = True
		End If
	End Sub

	Private Sub rbGetAllF_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbGetAllF.CheckedChanged
		If rbGetAllF.Checked Then
			strXQuery = "SELECT CustomerXML1.query('for $Result in /Customer return $Result') " + _
			 "FROM Customers;"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
			End If
			txtCustsXQuery.Text = strXQuery + strClick
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = txtCustsXQuery.Text
		End If
	End Sub

	Private Sub rbFindByCustCountryF_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbFindByCustCountryF.CheckedChanged
		If rbFindByCustCountryF.Checked Then
			strXQuery = "SELECT CustomerXML1.query('for $Result in /Customer return " + vbCrLf + _
			 "<USCustomer CustomerID=""{data($Result/CustomerID[1])}"">" + vbCrLf + _
			 "  <Name>{data($Result/CompanyName)}</Name>" + vbCrLf + _
			 "  <Contact>{concat(""Attn: "", data($Result/ContactName[1]), "", "", data($Result/ContactTitle[1]))}</Contact>" + vbCrLf + _
			 "  <Street>{data($Result/Address)}</Street>" + vbCrLf + _
			 "  <City>{data($Result/City)}</City>" + vbCrLf + _
			 "  <State>{data($Result/Region)}</State>" + vbCrLf + _
			 "  <ZIPCode>{data($Result/PostalCode)}</ZIPCode>" + vbCrLf + _
			"</USCustomer>')" + vbCrLf + _
			"FROM Customers WHERE Country = 'USA';"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
				'Ad hoc fix for no-namespace result
				strXQuery = Replace(strXQuery, "</nwc:", "</")
			End If
			Dim strPrefix As String = "-- Uses the xml.query method to return modified Customer documents for a specified Country" + vbCrLf + vbCrLf
			txtCustsXQuery.Text = strPrefix + strXQuery + strClick
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = txtCustsXQuery.Text
		End If
	End Sub

	Private Sub rbFindFaxF_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbFindFaxF.CheckedChanged
		If rbFindFaxF.Checked Then
			strXQuery = "SELECT CustomerXML1.query('for $Result in /Customer return $Result') " + _
			"FROM Customers WHERE CustomerXML1.exist('/Customer/Fax') = 0;"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
				'.exist() needs the namespace, too
				'strXQuery = Replace(strXQuery, ".exist('", ".exist('declare namespace nwc=""http://www.northwind.com/schemas/Customer""; ")
			End If
			txtCustsXQuery.Text = strXQuery + strClick
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = txtCustsXQuery.Text
		End If
	End Sub

	Private Sub rbInsertFax_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbInsertFax.CheckedChanged
		If rbInsertFax.Checked Then
			strXQuery = "UPDATE Customers SET CustomerXML1.modify('insert <Fax>(5) 555-3933 (Inserted)</Fax> " + _
			 "as last into (/Customer)[1]') WHERE CustomerID = 'ANTON'; "
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
				'Ad-hoc namespace fixup
				strXQuery = Replace(strXQuery, "<Fax>", "<nwc:Fax>")
			End If
			Dim strPrefix As String = "-- Uses the xml.modify method to add a missing <fax> element." + vbCrLf + _
			 "-- Be sure to execute the Delete Fax query before exiting the project." + vbCrLf + vbCrLf
			txtCustsXQuery.Text = strPrefix + strXQuery + strNoEdit
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = ""
		End If
	End Sub

	Private Sub rbModifyFax_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbModifyFax.CheckedChanged
		If rbModifyFax.Checked Then
			'Missing '/text()' throws an "Operand of 'text()' has invalid type" error with untyped columns
			'Presence of '/text()' throws a "The target of 'replace value of' must be a non-metadata attribute or an element 
			'with simple typed content, found 'element(Fax,xdt:untypedAny) ?' error with typed columns
			'Typed xml columns require '100 cast as xs:decimal ?' or other xs:datatype

			strXQuery = "UPDATE Customers SET CustomerXML1.modify('replace value of (/Customer/Fax[1]/text())[1] " + _
			  "with ""(5) 555-3934 (Modified)""') WHERE CustomerID = 'ANTON';"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
				strXQuery = Replace(strXQuery, "nwc:text()", "text()")
				If chkCustXML2Schema.Checked Then
					strXQuery = Replace(strXQuery, "/text()", "")
				End If
			Else
				If chkCustXML1Schema.Checked Then
					strXQuery = Replace(strXQuery, "/text()", "")
				End If
			End If
			Dim strPrefix As String = "-- Uses the xml.modify method to update the added <fax> element." + vbCrLf + _
			 "-- Be sure to execute the Delete Fax query before exiting the project." + vbCrLf + vbCrLf
			txtCustsXQuery.Text = strPrefix + strXQuery + strNoEdit
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = ""
		End If
	End Sub

	Private Sub rbDeleteFax_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbDeleteFax.CheckedChanged
		If rbDeleteFax.Checked Then
			strXQuery = "UPDATE Customers SET CustomerXML1.modify('delete /Customer[1]/Fax') " + _
			"WHERE CustomerID = 'ANTON';"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
			End If
			Dim strPrefix As String = "-- Uses the xml.modify method to delete the added <fax> element." + vbCrLf + vbCrLf
			txtCustsXQuery.Text = strPrefix + strXQuery + strNoEdit
			If blnShowPlanXML Then
				txtCustsXQResult.Text = ShowPlanXML(strXQuery)
			Else
				txtCustsXQResult.Text = ""
			End If
			btnExecuteCusts.Focus()
			pbFillColumn.Value = 0
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
			strCustsXQuery = ""
		End If
	End Sub

	Private Sub AddCustomerNamespace()
		'Add the nwc: prefix and http://www.northwind.com/schemas/Customer namespace
		strXQuery = Replace(strXQuery, "XML1", "XML2")
		strXQuery = Replace(strXQuery, "/", "/nwc:")
		strXQuery = Replace(strXQuery, ".query('", ".query('declare namespace nwc=""http://www.northwind.com/schemas/Customer""; ")
		strXQuery = Replace(strXQuery, ".exist('", ".exist('declare namespace nwc=""http://www.northwind.com/schemas/Customer""; ")
		strXQuery = Replace(strXQuery, ".modify('", ".modify('declare namespace nwc=""http://www.northwind.com/schemas/Customer""; ")
		strXQuery = Replace(strXQuery, ".value('", ".value('declare namespace nwc=""http://www.northwind.com/schemas/Customer""; ")
	End Sub

	Private Sub btnExecuteCusts_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecuteCusts.Click
		dgvShowPlan.Visible = False
		If rbDeleteFax.Checked Then
			Dim strText As String = txtCustsXQuery.Text
			rbFindFaxF.Checked = True
			txtCustsXQuery.Text = strText + vbCrLf + vbCrLf + txtCustsXQuery.Text
			rbInsertFax.Enabled = True
			rbModifyFax.Enabled = False
			rbDeleteFax.Enabled = False
			strCustsXQuery = ""
		ElseIf rbInsertFax.Checked Then
			strXQuery = "SELECT CustomerXML1.query('for $Result in /Customer return $Result') " + _
			   "FROM Customers WHERE CustomerID = 'ANTON'"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
			End If
			txtCustsXQuery.Text += vbCrLf + vbCrLf + strXQuery
			rbInsertFax.Enabled = False
			rbModifyFax.Enabled = True
			rbDeleteFax.Enabled = True
			strCustsXQuery = ""
		ElseIf rbModifyFax.Checked Then
			strXQuery = "SELECT CustomerXML1.query('for $Result in /Customer return $Result') " + _
			   "FROM Customers WHERE CustomerID = 'ANTON'"
			If rbCustXML2.Checked Then
				AddCustomerNamespace()
			End If
			If Not txtCustsXQuery.Text.Contains(strXQuery) Then
				txtCustsXQuery.Text += vbCrLf + vbCrLf + strXQuery
			End If
			strCustsXQuery = ""
		End If
        Application.DoEvents()
		If rbFindByCustCountryF.Checked Then
			txtCustsXQResult.Text = GetXQueryResult(txtCustsXQuery.Text, "USCustomers", 100, chkUseSqlXml.Checked, True, False)
		Else
			txtCustsXQResult.Text = GetXQueryResult(txtCustsXQuery.Text, "Customers", 100, chkUseSqlXml.Checked, True, False)
		End If
		'txtCustsXQuery.Text = Replace(txtCustsXQuery.Text, strClick, "")
		If blnShowPlanXML AndAlso strCustsXQuery.Length > 0 AndAlso txtCustsXQuery.Text <> strCustsXQuery Then
			pbFillColumn.Width = 175
			btnShowplan.Visible = True
		Else
			pbFillColumn.Width = 291
			btnShowplan.Visible = False
		End If
	End Sub

	Private Sub rbCustXML1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbCustXML1.CheckedChanged
		If Not blnHasLoaded Then
			'Initial values
			blnInsertFax1 = True
			blnInsertFax2 = True
			Return
		End If
		'Save button state
		If rbCustXML1.Checked Then
			blnInsertFax2 = rbInsertFax.Enabled
			blnModifyFax2 = rbModifyFax.Enabled
			blnDeleteFax2 = rbDeleteFax.Enabled
			rbInsertFax.Enabled = blnInsertFax1
			rbModifyFax.Enabled = blnModifyFax1
			rbDeleteFax.Enabled = blnDeleteFax1
		Else
			blnInsertFax1 = rbInsertFax.Enabled
			blnModifyFax1 = rbModifyFax.Enabled
			blnDeleteFax1 = rbDeleteFax.Enabled
			rbInsertFax.Enabled = blnInsertFax2
			rbModifyFax.Enabled = blnModifyFax2
			rbDeleteFax.Enabled = blnDeleteFax2
		End If

		'Refresh the XQuery text box contents
		Dim intCtr As Integer
		Dim rbSel As RadioButton
		With gbCustomersXQuery
			For intCtr = 0 To .Controls.Count - 1
				Dim objSel As Object = .Controls(intCtr)
				If TypeOf objSel Is RadioButton Then
					rbSel = CType(.Controls(intCtr), RadioButton)
					If rbSel.Checked Then
						rbSel.Checked = False
						rbSel.Checked = True
					End If
				End If
			Next
		End With
	End Sub
End Class