udtinteractive.vb

来自「wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重」· VB 代码 · 共 315 行

Option Explicit On
Option Strict On

Imports System.Data
Imports System.Data.Sql
Imports System.Data.SqlClient
Imports System.IO
Imports System.Xml
Imports System.Text

Public Class frmInteractive
	Private cnNwind As SqlConnection
	Private cmNwind As SqlCommand
	Private strPath As String = Application.StartupPath + "\"


	Private Sub UDTClient_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
		Dim intCount As Integer
		Dim strConn As String = My.Settings.NorthwindConnection
		Dim strMsg As String
		'Uncomment to run test procedure
		'WriteXMLString()
		Try
			cnNwind = New SqlConnection(strConn)
			'Test for existence of Point and Address user-defined types
			Dim strSQL As String = "SELECT COUNT(*) FROM dbo.systypes WHERE name = 'Point' AND xtype = 240"
			cmNwind = New SqlCommand(strSQL, cnNwind)
			cmNwind.CommandType = CommandType.Text
			cnNwind.Open()
			intCount = CInt(cmNwind.ExecuteScalar)
			strSQL = "SELECT COUNT(*) FROM dbo.systypes WHERE name = 'Address' AND xtype = 240"
			cmNwind.CommandText = strSQL
			intCount += CInt(cmNwind.ExecuteScalar)
			If intCount = 2 Then
				'Test for existence of PointsUDT and AddressesUDT tables
				strSQL = "SELECT COUNT(*) FROM dbo.sysobjects WHERE id = object_id(N'[dbo].[PointsUDT]') AND OBJECTPROPERTY(id, N'IsUserTable') = 1"
				cmNwind.CommandText = strSQL
				intCount = CInt(cmNwind.ExecuteScalar)
				strSQL = "SELECT COUNT(*) FROM dbo.sysobjects WHERE id = object_id(N'[dbo].[AddressesUDT]') AND OBJECTPROPERTY(id, N'IsUserTable') = 1"
				cmNwind.CommandText = strSQL
				intCount += CInt(cmNwind.ExecuteScalar)
				cnNwind.Close()
				If intCount < 2 Then
					strMsg = "The 'PointsUDT' and/or 'AddressesUDT' table(s) aren't present in the " + _
					 "SQL Server 2005 Northwind database. These tables are required for the 'UDTTables' form." + _
					vbCrLf + vbCrLf + "Do you want to create or recreate them now?" + vbCrLf + vbCrLf + _
					"(You can drop the tables to modify the 'UserDefinedTypesCLR' assembly from the 'UDTTables' form.)"
					If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "PointsUDT and/or AddressesUDT Tables Missing") = MsgBoxResult.Yes Then
						'Generate the tables
						If CreateUDTTables() Then
							strMsg = "You can enable writing code to create and manipulate local instances of Point and Address UDT objects " + _
							 "by adding a reference to 'UserDefinedTypesCLR.dll'. (This project doesn't require the reference.)"
							MsgBox(strMsg, MsgBoxStyle.Information, "Optional Reference for Point and Address UDTs")
						Else
							Me.btnShowTables.Enabled = False
						End If
					Else
						Me.btnShowTables.Enabled = False
					End If
					If Not Me.btnShowTables.Enabled Then
						strMsg = "The application's PointsUDT and AddressesUDT tables' test form will be disabled."
						MsgBox(strMsg, MsgBoxStyle.Information, "Disabling Tables Test Form")
					End If
				End If
			Else
				cnNwind.Close()
				strMsg = "You haven't added the 'Point' and 'Address' user-defined " + _
				 "types to the SQL Server 2005 Northwind database. You must build and deploy " + _
				 "these UDTs with the 'UserDefinedTypes.sln' project before using this application."
				MsgBox(strMsg, MsgBoxStyle.Exclamation, "Point and Address UDTs Missing")
				Exit Sub
			End If
			'Load the T-SQL text box
			txtSQL.Text = My.Computer.FileSystem.ReadAllText(strPath + "PointDefault.sql")
			cnNwind.Close()
		Catch exc As Exception
			strMsg = "Loading exceptions usually result from " + _
			 "an incorrect connection string (currently: '" + strConn + "')." + _
			 vbCrLf + vbCrLf + "Open app.config and verify or edit " + _
			 "the NorthwindConnection '<connectionString>' attribute. " + vbCrLf + vbCrLf + exc.Message
			MsgBox(strMsg, MsgBoxStyle.Exclamation, "Exception on Loading")
		Finally
			If cnNwind IsNot Nothing Then
				cnNwind.Close()
			End If
		End Try
	End Sub

	Private Function CreateUDTTables() As Boolean
		'Create the PointsUDT and AddressesUDT tables
		Dim strSQL As String
		Dim intRetVal As Integer
		Dim intSuccess As Integer
		Dim intRows As Integer
		Try
			'Drop the PointsUDT table, if present
			strSQL = "USE Northwind; " + _
			 "IF EXISTS (SELECT * FROM dbo.sysobjects " + _
			 "WHERE id = object_id(N'dbo.PointsUDT') AND " + _
			 "OBJECTPROPERTY(id, N'IsUserTable') = 1)" + _
			 "DROP TABLE [dbo].[PointsUDT];"
			cmNwind.CommandText = strSQL
			If cnNwind.State <> ConnectionState.Open Then
				cnNwind.Open()
			End If
			intRetVal = cmNwind.ExecuteNonQuery

			'Create and populate the PointsUDT table
			strSQL = "USE Northwind; CREATE TABLE dbo.PointsUDT(" + _
			 "PointID int NOT NULL, PointUDT Point NULL, " + _
			 "CONSTRAINT PK_Points " + _
			 "PRIMARY KEY CLUSTERED (PointID) " + _
			 "WITH (IGNORE_DUP_KEY = OFF)) ON [PRIMARY]; "
			cmNwind.CommandText = strSQL
			intSuccess += cmNwind.ExecuteNonQuery

			Dim intRow As Integer
			For intRow = 1 To 19
				strSQL = "INSERT PointsUDT VALUES(" + intRow.ToString + _
				", '" + intRow.ToString + "," + (intRow - 10).ToString + "')"
				cmNwind.CommandText = strSQL
				intRows += cmNwind.ExecuteNonQuery()
			Next intRow

			'Drop the AddressesUDT table, if present
			strSQL = "USE Northwind; " + _
			 "IF EXISTS (SELECT * FROM dbo.sysobjects " + _
			 "WHERE id = object_id(N'dbo.AddressesUDT') AND " + _
			 "OBJECTPROPERTY(id, N'IsUserTable') = 1)" + _
			 "DROP TABLE [dbo].[AddressesUDT];"
			cmNwind.CommandText = strSQL
			intRetVal = cmNwind.ExecuteNonQuery

			'Create and populate the AddressesUDT table
			strSQL = "USE Northwind; CREATE TABLE dbo.AddressesUDT(" + _
			 "CustomerID varchar(5) NOT NULL, AddressUDT Address NULL, " + _
			 "CONSTRAINT PK_Addresses " + _
			 "PRIMARY KEY CLUSTERED (CustomerID) " + _
			 "WITH (IGNORE_DUP_KEY = OFF)) ON [PRIMARY]; "
			cmNwind.CommandText = strSQL
			intSuccess += cmNwind.ExecuteNonQuery

			strSQL = "SELECT COUNT(CustomerID) FROM Customers"
			cmNwind.CommandText = strSQL
			intRows = CType(cmNwind.ExecuteScalar, Integer)
			Dim astrCusts((intRows - 1), 6) As String

			strSQL = "SELECT CustomerID, CompanyName, Address, City, " + _
			 "Region, PostalCode, Country FROM Customers"
			cmNwind.CommandText = strSQL

			intRow = 0
			Dim rdrCusts As SqlDataReader = cmNwind.ExecuteReader
			With rdrCusts
				If .HasRows Then
					While .Read
						'CustomerID
						astrCusts(intRow, 0) = .GetString(0)
						'CompanyName
						astrCusts(intRow, 1) = .GetString(1)
						'Address
						astrCusts(intRow, 2) = .GetString(2)
						'City
						astrCusts(intRow, 3) = .GetString(3)
						'Region
						If .IsDBNull(4) Then
							'Substitute empty string for null
							astrCusts(intRow, 4) = String.Empty
						Else
							astrCusts(intRow, 4) = .GetString(4)
						End If
						'PostalCode
						If .IsDBNull(5) Then
							'Substitute empty string for null
							astrCusts(intRow, 5) = String.Empty
						Else
							astrCusts(intRow, 5) = .GetString(5)
						End If
						'Country
						astrCusts(intRow, 6) = .GetString(6)
						intRow += 1
					End While
				End If
				.Close()
			End With

			For intRow = 0 To intRows - 1
				'INSERTS with escapted single quotes
				'Example: 
				strSQL = "INSERT AddressesUDT VALUES('" + _
				astrCusts(intRow, 0) + "', '" + _
				Replace(astrCusts(intRow, 1), "'", "''") + ";" + _
				Replace(astrCusts(intRow, 2), "'", "''") + ";" + _
				Replace(astrCusts(intRow, 3), "'", "''") + ";" + _
				Replace(astrCusts(intRow, 4), "'", "''") + ";" + _
				astrCusts(intRow, 5) + ";" + _
				Replace(astrCusts(intRow, 6), "'", "''") + "');"
				cmNwind.CommandText = strSQL
				cmNwind.ExecuteNonQuery()
			Next intRow
			cnNwind.Close()
			If intSuccess = -2 Then
				Return True
			End If
		Catch exc As Exception
			cnNwind.Close()
			MsgBox(exc.Message, MsgBoxStyle.Exclamation, "Exception Creating PointsUDT and AddressesUDT Tables")
		End Try
	End Function

	Private Sub btnExecSqlCmd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecSqlCmd.Click
		Me.Cursor = Cursors.WaitCursor
		Try
            'Following assumes a standard app.config command string: Data Source=<InstanceName>;...
			Dim strInst As String = cnNwind.ConnectionString
            strInst = strInst.Substring(12)
			strInst = strInst.Substring(0, strInst.IndexOf(";"c))
			Dim strInput As String
			Dim strOutput As String
			If rbAddress.Checked Then
				btnDefault.Text = "&Restore Default Address T-SQL"
				strInput = strPath + "Address.sql"
				strOutput = strPath + "Address.txt"
			Else
				btnDefault.Text = "&Restore Default Point T-SQL"
				strInput = strPath + "Point.sql"
				strOutput = strPath + "Point.txt"
			End If
            Application.DoEvents()
			'Write the text box text to the input file
			With My.Computer.FileSystem
				.DeleteFile(strInput)
				.DeleteFile(strOutput)
				.WriteAllText(strInput, txtSQL.Text, False)
			End With
			'Create the SQLCMD string to read from the strInput file and write to the strOutput file
			Dim strSqlCmd As String
			strSqlCmd = "sqlcmd -S " + strInst + " -d Northwind -i """ + strInput + _
			 """ -o """ + strOutput + """ -y 0 -u"
			'Sample: sqlcmd -S localhost -d Northwind -i "D:\WROX\Projects\Chapter11\UserDefinedTypesClient\bin\Point.sql" -o "D:\WROX\Projects\Chapter11\UserDefinedTypesClient\bin\Point.txt" -y 0 -u
			'Execute the SQLCMD string
			Shell(strSqlCmd, AppWinStyle.Hide, True)
			'Display the result
			With txtMessages
				.Text = My.Computer.FileSystem.ReadAllText(strOutput)
				If .Text.IndexOf("--") > 0 Then
					'Text box includes results from SELECT statements which return
					'several hundred hyphens and spaces
					.Text = Replace(.Text, "   ", "")
					.Text = Replace(.Text, "--", "")
					.Text = Replace(.Text, ControlChars.Tab, "   ")
				End If
			End With
		Catch exc As Exception
			Me.Cursor = Cursors.Default
			MsgBox(exc.Message, MsgBoxStyle.Exclamation, "Exception Executing SQLCMD")
		Finally
			Me.Cursor = Cursors.Default
		End Try
	End Sub

	Private Sub btnDefault_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDefault.Click
		Dim strInput As String
		If rbAddress.Checked Then
			strInput = strPath + "AddressDefault.sql"
		Else
			strInput = strPath + "PointDefault.sql"
		End If
		txtSQL.Text = My.Computer.FileSystem.ReadAllText(strInput)
	End Sub

	Private Sub rbPoint_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbPoint.CheckedChanged
		Dim strInput As String
		txtMessages.Text = ""
		If rbAddress.Checked Then
			btnDefault.Text = "&Restore Default Address T-SQL"
			strInput = strPath + "Address.sql"
		Else
			btnDefault.Text = "&Restore Default Point T-SQL"
			strInput = strPath + "Point.sql"
		End If
		txtSQL.Text = My.Computer.FileSystem.ReadAllText(strInput)
	End Sub

	Private Sub btnShowTables_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnShowTables.Click
		Me.Hide()
		frmTables.Show()
	End Sub

	Private Sub WriteXMLString()
		'Test procedure for UserDefinedTypesCLR AddressXML() function
		Dim msAddr As New MemoryStream()
		Dim xtwAddr As New XmlTextWriter(msAddr, Encoding.UTF8)
		With xtwAddr
			.Formatting = Formatting.Indented
			.Indentation = 2
			.WriteStartElement("BillAddress")
			.WriteElementString("Name", "Rattlesnake & Company")
			.WriteElementString("Address", "123 Elm Street")
			.WriteElementString("City", "Oakland")
			.WriteElementString("Region", "")
			.WriteElementString("PostalCode", "")
			.WriteElementString("Country", "USA")
			.WriteEndElement()
			.Flush()
			.Close()
		End With
		Dim strAddrXML As String = Encoding.UTF8.GetString(msAddr.GetBuffer())
		msAddr.Close()
		'Buffer has extra characters at the end
		Dim intLength As Integer = strAddrXML.IndexOf("</BillAddress>") + 13
		strAddrXML = strAddrXML.Substring(1, intLength)
	End Sub
End Class