address.vb

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

Imports System
Imports System.Data.SqlTypes
Imports System.Data.Sql
'Imports System.Data.SqlServer
Imports Microsoft.SqlServer.Server

'Added
Imports System.Data.SqlClient
Imports System.IO
Imports System.Xml
Imports System.Text

<Serializable(), SqlUserDefinedType(Format.UserDefined, _
 IsByteOrdered:=True, IsFixedLength:=False, MaxByteSize:=500)> _
Public Class Address
	'The Address UDT expects zero-length strings instead of nulls 
	'for Region and PostalCode fields
	Implements INullable, IBinarySerialize

	Private blnIsNull As Boolean
	Private strName As String
	Private strAddress As String
	Private strCity As String
	Private strRegion As String
	Private strPostalCode As String
	Private strCountry As String

	Public Sub New()
		'Default constructor (required for a class)
		Me.blnIsNull = True
		Me.strName = ""
		Me.strAddress = ""
		Me.strCity = ""
		Me.strRegion = ""
		Me.strPostalCode = ""
		Me.strCountry = ""
	End Sub

	Public ReadOnly Property IsNull() As Boolean _
	 Implements INullable.IsNull
		'IsNull property is required for all UDTs
		Get
			Return blnIsNull
		End Get
	End Property

	Public Shared ReadOnly Property Null() As Address
		'Null property is required for all UDTs
		Get
			Dim objAddr As New Address()
			objAddr.blnIsNull = True
			Return objAddr
		End Get
	End Property

	Public Shared Function Parse(ByVal sqlAddr As SqlString) As Address
		'Parse is required for all UDTs
		If sqlAddr.IsNull Then
			Return Nothing
		Else
			Dim objAddr As New Address
			Dim str As String = sqlAddr.ToString
			'Throw New ArgumentException(str)
			Dim astrAddr As String() = str.Split(";"c)
			If astrAddr.Length < 6 Then
				Throw New ArgumentException("Address requires 5 elements (" + (astrAddr.Length - 1).ToString + " supplied.)", "Parse")
				Return Nothing
			End If
			If astrAddr(0) Is Nothing OrElse astrAddr(0).Length = 0 Then
				Throw New ArgumentException("Name field is missing.", "Parse")
				Return Nothing
			ElseIf astrAddr(0).Length > 40 Then
				Throw New ArgumentException("Name field cannot exceed 40 characters.", "Parse")
			End If
			objAddr.strName = astrAddr(0)
			objAddr.strAddress = astrAddr(1)
			If astrAddr(1) Is Nothing OrElse astrAddr(1).Length = 0 Then
				Throw New ArgumentException("Address field is missing.", "Parse")
				Return Nothing
			ElseIf astrAddr(1).Length > 60 Then
				Throw New ArgumentException("Address field cannot exceed 60 characters.", "Parse")
			End If
			objAddr.strCity = astrAddr(2)
			If astrAddr(2) Is Nothing OrElse astrAddr(2).Length = 0 Then
				Throw New ArgumentException("City field is missing.", "Parse")
				Return Nothing
			ElseIf astrAddr(2).Length > 15 Then
				Throw New ArgumentException("City field cannot exceed 15 characters.", "Parse")
			End If
			If astrAddr(3).Length > 15 Then
				Throw New ArgumentException("Region field cannot exceed 15 characters.", "Parse")
			End If
			objAddr.strRegion = astrAddr(3)
			If astrAddr(4).Length > 10 Then
				Throw New ArgumentException("PostalCode field cannot exceed 10 characters.", "Parse")
			End If
			objAddr.strPostalCode = astrAddr(4)
			If astrAddr(5) Is Nothing OrElse astrAddr(5).Length = 0 Then
				Throw New ArgumentException("Country field is missing.", "Parse")
				Return Nothing
			ElseIf astrAddr(5).Length > 15 Then
				Throw New ArgumentException("Country field cannot exceed 15 characters.", "Parse")
			End If
			objAddr.strCountry = astrAddr(5)
			objAddr.blnIsNull = False
			Return objAddr
		End If
	End Function

	Public Overrides Function ToString() As String
		'ToString is required for all UDTs
		If Me.IsNull Then
			Return "Null"
		Else
			Dim strDelimeter As String = ";"
			Return Me.strName + strDelimeter + Me.strAddress + strDelimeter + Me.strCity + strDelimeter + Me.strRegion + strDelimeter + Me.strPostalCode + strDelimeter + Me.strCountry
		End If
	End Function

	'Fields
	Public Property Name() As String
		Get
			Return Me.strName
		End Get
		Set(ByVal value As String)
			If value.Length = 0 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Name field is missing.", "Property")
			ElseIf value.Length > 40 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Name field cannot exceed 40 characters.", "Property")
			Else
				Me.strName = value
				Me.blnIsNull = False
			End If
		End Set
	End Property

	Public Property Address() As String
		Get
			Return Me.strAddress
		End Get
		Set(ByVal value As String)
			If value.Length = 0 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Address field is missing.", "Property")
			ElseIf value.Length > 60 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Address field cannot exceed 40 characters.", "Property")
			Else
				Me.strAddress = value
				Me.blnIsNull = False
			End If
		End Set
	End Property

	Public Property City() As String
		Get
			Return Me.strCity
		End Get
		Set(ByVal value As String)
			If value.Length = 0 Then
				Me.blnIsNull = True
				Throw New ArgumentException("City field is missing.", "Property")
			ElseIf value.Length > 15 Then
				Me.blnIsNull = True
				Throw New ArgumentException("City field cannot exceed 40 characters.", "Property")
			Else
				Me.strCity = value
				Me.blnIsNull = False
			End If
		End Set
	End Property

	Public Property Region() As String
		Get
			Return Me.strRegion
		End Get
		Set(ByVal value As String)
			If value.Length > 15 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Region field cannot exceed 15 characters.", "Property")
			Else
				Me.strRegion = value
				Me.blnIsNull = False
			End If
		End Set
	End Property

	Public Property PostalCode() As String
		Get
			Return Me.strPostalCode
		End Get
		Set(ByVal value As String)
			If value.Length > 15 Then
				Me.blnIsNull = True
				Throw New ArgumentException("PostalCode field cannot exceed 10 characters.", "Property")
			Else
				Me.strPostalCode = value
				Me.blnIsNull = False
			End If
		End Set
	End Property

	Public Property Country() As String
		Get
			Return Me.strCountry
		End Get
		Set(ByVal value As String)
			If value.Length = 0 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Country field is missing.", "Property")
			ElseIf value.Length > 15 Then
				Me.blnIsNull = True
				Throw New ArgumentException("Country field cannot exceed 40 characters.", "Property")
			Else
				Me.strCountry = value
				Me.blnIsNull = False
			End If
		End Set
	End Property

	'Optional function(s)
	Public Function MailingLabel() As String
		If Me.IsNull Then
			Return Nothing
		End If
		Dim strLabel As String = Me.strName + vbCrLf + Me.strAddress + vbCrLf + Me.strCity
		If Me.strRegion = Nothing OrElse Me.strRegion.Length = 0 Then
			'Region is blank or null (most records other than USA)
		Else
			strLabel += ", " + strRegion
		End If
		If Me.strPostalCode = Nothing OrElse Me.strPostalCode.Length = 0 Then
			'No PostalCode (Ireland only for Northwind Customers table)
		Else
			strLabel += "  " + strPostalCode
		End If
		If Me.strCountry <> "USA" Then
			'Don't specify country for US addresses
			strLabel += vbCrLf + strCountry
		End If
		strLabel += vbCrLf
		Return strLabel
	End Function

	Public Function MailingListHeaderCSV() As String
		Dim strQ As String = ControlChars.Quote
		Dim strSep As String = strQ + "," + strQ
		Return strQ + "Name" + strSep + "Address" + strSep + "City" + strSep + _
		 "Region" + strSep + "PostalCode" + strSep + "Country" + strQ
	End Function

	Public Function MailingListCSV() As String
		If Me.IsNull Then
			Return Nothing
		End If
		Dim strQ As String = ControlChars.Quote
		Dim strSep As String = strQ + "," + strQ
		Dim strCSV As String = strQ + Me.Name + strSep + Me.Address + strSep + Me.City + strQ + ","
		'Process null (empty) Region or PostalCode column values
		If Me.Region.Length > 0 Then
			strCSV += strQ + Me.Region + strQ + ","
		Else
			strCSV += ","
		End If
		If Me.PostalCode.Length > 0 Then
			strCSV += strQ + Me.PostalCode + strQ + ","
		Else
			strCSV += ","
		End If
		strCSV += strQ + Me.Country + strQ + vbCrLf
		Return strCSV
	End Function

	<SqlMethod(DataAccess:=DataAccessKind.Read)> _
	 Public Function AddressXML() As String
		'Return the XML representation of an address
		If Me.IsNull Then
			Return Nothing
        End If
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmNwind As New SqlCommand
        Dim strCustomerID As String = Nothing
        Try
            cnNwind.Open()
            With cmNwind
                .Connection = cnNwind
                .CommandText = "SELECT CustomerID FROM Customers WHERE " + _
                 "CompanyName = N'" + Replace(Me.Name, "'", "''") + "'"
                .CommandType = CommandType.Text
                strCustomerID = .ExecuteScalar.ToString
            End With
        Catch exc As Exception
            Dim strMsg As String = exc.Message
            'Do nothing
        End Try

		Dim msAddr As New MemoryStream()
		Dim xtwAddr As New XmlTextWriter(msAddr, Encoding.UTF8)
		With xtwAddr
			.Formatting = Formatting.Indented
			.Indentation = 2
			.WriteStartElement("Address")
			If strCustomerID Is Nothing OrElse strCustomerID = "" Then
				.WriteAttributeString("CustomerID", "XXXXX")
			Else
				.WriteAttributeString("CustomerID", strCustomerID)
			End If
			.WriteElementString("Name", Me.Name)
			.WriteElementString("Street", Me.Address)
			.WriteElementString("City", Me.City)
			.WriteElementString("Region", Me.Region)
			.WriteElementString("PostalCode", Me.PostalCode)
			.WriteElementString("Country", Me.Country)
			.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("</Address>") + 9
		strAddrXML = strAddrXML.Substring(1, intLength)
		Return strAddrXML
	End Function

	Public Function IsEqualTo(ByVal addrTest As Address) As Boolean
		'Test for string equality
		If addrTest.ToString() = Me.ToString() Then
			Return True
		Else
			Return False
		End If
	End Function

	<SqlMethod(DataAccess:=DataAccessKind.Read)> _
	Public Function OrderCountByCustomerID(ByVal strCustomerID As String) As Integer
		'Return the number of orders from the customer specified by CustomerID 
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmNwind As New SqlCommand
        cnNwind.Open()
        With cmNwind
            .Connection = cnNwind
            .CommandText = "SELECT COUNT(OrderID) FROM Orders " + _
             "WHERE CustomerID = '" + strCustomerID + "'"
            .CommandType = CommandType.Text
            Return CInt(.ExecuteScalar())
        End With
        cnNwind.Close()
	End Function

	<SqlMethod(DataAccess:=DataAccessKind.Read)> _
	Public Function CustomerOrderCount() As Integer
		'Return the number of orders from the current-instance customer 
		If Me.IsNull Then
			Return 0
		End If
        Dim cnNwind As New SqlConnection("context connection=true")
        Dim cmNwind As New SqlCommand
        cnNwind.Open()
        With cmNwind
            .Connection = cnNwind
            .CommandText = "SELECT COUNT(OrderID) FROM Orders " + _
             "WHERE CustomerID IN (SELECT CustomerID FROM Customers WHERE " + _
             "CompanyName = N'" + Replace(Me.Name, "'", "''") + "')"
            .CommandType = CommandType.Text
            Return CInt(.ExecuteScalar())
        End With
        cnNwind.Close()
	End Function

	Public Overrides Function GetHashCode() As Integer
		'Optional
		If Me.IsNull Then
			Return 0
		End If
		Return Me.ToString().GetHashCode()
	End Function

	'Required serializer and deserializer methods
	Public Overridable Sub Write(ByVal binWriter As BinaryWriter) _
	 Implements IBinarySerialize.Write
		Dim bytHeader As Byte
		If Me.IsNull Then
			bytHeader = 0
		Else
			bytHeader = 1
		End If
		With binWriter
			.Write(bytHeader)
			If bytHeader = 0 Then
				Return
			End If
			.Write(Me.Name)
			.Write(Me.Address)
			.Write(Me.City)
			.Write(Me.Region)
			.Write(Me.PostalCode)
			.Write(Me.Country)
		End With
	End Sub

	Public Sub Read(ByVal binReader As BinaryReader) _
	 Implements IBinarySerialize.Read
		'Required for Format.UserDefined, not Format.Native
		Dim bytHeader As Byte = binReader.ReadByte()
		If bytHeader = 0 Then
			Me.blnIsNull = True
			Return
		End If
		Me.blnIsNull = False
		With binReader
			Me.strName = .ReadString()
			Me.strAddress = .ReadString()
			Me.strCity = .ReadString()
			Me.strRegion = .ReadString()
			Me.strPostalCode = .ReadString()
			Me.strCountry = .ReadString()
		End With
	End Sub
End Class