client.vb

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

Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.Net
Imports System.Web.Services.Protocols
Imports System.Xml

Public Class Client
	Private wsNwind As New WSNwindEP.NorthwindEP
	Private dsNwind As DataSet
    Private dcNwind As New BindingSource
	Private blnIsLoaded As Boolean
	Private strPath As String = Application.StartupPath + "\"
	Private strFileName As String

	Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
		cboCategoryName.SelectedIndex = 0
		cboYearSBC.SelectedIndex = 1
		cboYearESC.SelectedIndex = 1
		'Use Windows credentials
		wsNwind.Credentials = CredentialCache.DefaultCredentials

		'Code to set a MindReef SOAPscope proxy (see http://www.mindreef.com for details)
		'Midreef translates localhost to 127.0.0.1, so a server name is required
		'Dim proxyObject As New WebProxy("http://oakleaf-ms16:5049", False)
		'wsNwind.Proxy = proxyObject

		'Set the DataGridView not editable
		dgvNwind.ReadOnly = True
		dgvNwind.AllowUserToAddRows = False
		dgvNwind.AllowUserToDeleteRows = False

		'Default ad-hoc query
		txtSQL.Text = "SELECT * " + vbCrLf + "FROM Products "

		'Error text box
		With txtSoapError
			.Top = dgvNwind.Top
			.Left = dgvNwind.Left
			.Height = dgvNwind.Height
			.Width = dgvNwind.Width
		End With

		btnExecuteCustID.Enabled = False
		blnIsLoaded = True
	End Sub

	Private Sub ExecuteWebMethod(ByVal intMethod As Integer)
		Dim objResult() As Object = Nothing
		Dim blnForXml As Boolean
		Try
			'Execute the specified WebMethod and populate a DataSet and DataGridView
			Dim lngTime As Long = Now.Ticks
			Select Case intMethod
				Case 1
					dsNwind = wsNwind.TenMostExpensiveProducts
					lblHeader.Text = "Ten Most Expensive Products"
					strFileName = strPath + "TenMostExpensiveProducts.xml"
				Case 2
					dsNwind = wsNwind.CustomerOrderHistory(txtCustomerID.Text)
					lblHeader.Text = "Customer Order History for " + txtCustomerID.Text
					strFileName = strPath + "CustomerOrderHistory.xml"
				Case 3
					dsNwind = wsNwind.SalesByCategory(cboCategoryName.SelectedItem.ToString, cboYearSBC.SelectedItem.ToString)
					lblHeader.Text = "Sales by Category for " + cboCategoryName.SelectedItem.ToString + " in " + cboYearSBC.SelectedItem.ToString
					strFileName = strPath + "SalesByCategory.xml"
				Case 4
					Dim strYear As String = cboYearESC.SelectedItem.ToString
					Dim strBegDate As String = "1/1/" + strYear
					Dim strEndDate As String = "12/31/" + strYear
					Dim strSQL As String = "EXECUTE [Employee Sales by Country] '" + strBegDate + "', '" + strEndDate + "'"
					objResult = wsNwind.sqlbatch(strSQL, Nothing)
					dsNwind = CType(objResult(0), DataSet)
					lblHeader.Text = "Employee Sales by Country for " + cboYearESC.SelectedItem.ToString
					strFileName = strPath + "EmployeeSalesByCountry.xml"

					'Following doesn't work due to parameter datetime datatype
					'SQLS 2005 Bug report 154266906 12/8/2004
					'Response on 12/10/2004 confirms that datetime params don't work
					Dim datBegDate As New SqlDateTime(1997, 1, 1)
					Dim datEndDate As New SqlDateTime(1997, 12, 31)
					'dsNwind = wsNwind.EmployeeSalesByCountry(datBegDate, datEndDate)
				Case 5
					objResult = wsNwind.sqlbatch(txtSQL.Text, Nothing)
					If txtSQL.Text.ToUpper.Contains("FOR XML") Then
						'Display the resultset in the text box
						Dim xmlResult As XmlElement = CType(objResult(0), XmlElement)
						If objResult.Length > 1 Then
							'Display the rowcount
							Dim srcCount As WSNwindEP.SqlRowCount = CType(objResult(1), WSNwindEP.SqlRowCount)
							txtRows.Text = srcCount.Count.ToString
						Else
							txtRows.Text = "N/A"
						End If
						txtSoapError.Text = Replace(xmlResult.OuterXml, "><", ">" + vbCrLf + "<")
						txtSoapError.Visible = True
						dgvNwind.Visible = False
                        blnForXml = True
					Else
                        'Load the DataGridView
                        dsNwind = CType(objResult(0), DataSet)
                        txtSoapError.Visible = False
                        dgvNwind.Visible = True
					End If
					lblHeader.Text = "Ad Hoc Batch Query"
					strFileName = strPath + "AdHocBatchQuery.xml"
			End Select
			lngTime = Now.Ticks - lngTime
			txtTime.Text = Format(lngTime / 10000000, "#0.000")
			If Not blnForXml Then
				With dgvNwind
					.DataSource = dsNwind
					.DataMember = dsNwind.Tables(0).TableName
					txtRows.Text = dsNwind.Tables(0).Rows.Count.ToString
				End With

				FormatDGV(intMethod)

				'Save the XML file and imported schemas (*_app1.xsd and *_app2.xsd)
				dsNwind.WriteXml(strFileName, XmlWriteMode.WriteSchema)
			End If
		Catch excSoap As SoapException
			'Usually a server error
			Dim strMessage As String = "Message: " + excSoap.Message + vbCrLf + vbCrLf
			Dim strFaultCode As String = "FaultCode: " + excSoap.Code.ToString + vbCrLf + vbCrLf
			Dim strActor As String = "Actor: " + excSoap.Actor.ToString + vbCrLf + vbCrLf
			Dim strDetails As String = "Details: " + vbCrLf + Replace(excSoap.Detail.OuterXml, "><", ">" + vbCrLf + "<") + vbCrLf + vbCrLf
			Dim strMsg As String = strMessage + "Display the SOAP fault details?"
			If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "SQL Server 2005 Threw SOAP Fault") = MsgBoxResult.Yes Then
				With txtSoapError
					.Text = strMessage + strFaultCode + strActor + strDetails
					.Visible = True
				End With
			End If

		Catch excSys As System.Exception
			'Usually a bad query
			Dim strError As String = Nothing
			If objResult Is Nothing Then
				strError = excSys.Message + vbCrLf + vbCrLf + _
				"Run the 'CreateNwindEndpoint.sql' script from the application folder."
				MsgBox(strError, MsgBoxStyle.Exclamation, "NorthwindEP Endpoint Probably Is Missing")
			Else
				Dim strType As String = objResult(0).ToString
				If strType.Contains("SqlMessage") Then
					Dim sqlMessage As SqlNativeWebServices.WSNwindEP.SqlMessage
					sqlMessage = CType(objResult(0), SqlNativeWebServices.WSNwindEP.SqlMessage)
					strError = sqlMessage.Message
				Else
					strError = excSys.Message
				End If
				If excSys.Message.Contains("Specified cast is not valid") Then
					Dim strMsg As String = "Your SQL statement did not return a DataSet or <SqlXml> document." + vbCrLf + vbCrLf + _
					 "Error Message: " + strError + vbCrLf + vbCrLf + "Please correct the error and try again."
					MsgBox(strMsg, MsgBoxStyle.Exclamation, "Bad Ad Hoc Query")
				Else
					MsgBox(excSys.Message + excSys.StackTrace, MsgBoxStyle.Exclamation, "System Exception with Ad Hoc Query")
				End If
			End If
		End Try
	End Sub

	Private Sub FormatDGV(ByVal intMethod As Integer)
		'Format the DataGridView for three of the SPs
		With dgvNwind
			Dim intCol As Integer
			For intCol = 0 To .Columns.Count - 1
				.Columns(intCol).DefaultCellStyle.WrapMode = DataGridViewTriState.False
				If intMethod >= 4 Then
                    .Columns(intCol).AutoSizeMode = DataGridViewAutoSizeColumnMode.ColumnHeader
				Else
                    .Columns(intCol).AutoSizeMode = DataGridViewAutoSizeColumnMode.AllCells
				End If
			Next
			'.Columns(1).AutoSizeCriteria = DataGridViewAutoSizeColumnCriteria.HeaderAndRows
			If intMethod < 4 Then
				.Columns(1).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
			End If
			If intMethod = 1 Or intMethod = 3 Then
				.Columns(1).DefaultCellStyle.Format = "C"
			End If
			If intMethod = 4 Then
				For intCol = 3 To .Columns.Count - 1
					.Columns(intCol).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight
				Next
				.Columns(5).DefaultCellStyle.Format = "C"
			End If
		End With
	End Sub


	'*************************************
	'RadioButton and Button Event Handlers
	'*************************************

	Private Sub DisableAll()
		'Reset all controls
		txtCustomerID.Enabled = False
		txtSQL.Enabled = False
		cboCategoryName.Enabled = False
		cboYearSBC.Enabled = False
		cboYearESC.Enabled = False
		btnExecute.Enabled = False
		btnExecuteCustID.Enabled = False
		txtSoapError.Visible = False
	End Sub

	Private Sub rbMostExpensive_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbMostExpensive.CheckedChanged
		If rbMostExpensive.Checked Then
			DisableAll()
			ExecuteWebMethod(1)
		End If
	End Sub

	Private Sub rbOrderHistory_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbOrderHistory.CheckedChanged
		If rbOrderHistory.Checked Then
			DisableAll()
			ExecuteWebMethod(2)
			txtCustomerID.Enabled = True
		End If
	End Sub

	Private Sub rbByCategory_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbByCategory.CheckedChanged
		If rbByCategory.Checked Then
			DisableAll()
			ExecuteWebMethod(3)
			cboCategoryName.Enabled = True
			cboYearSBC.Enabled = True
		End If
	End Sub

	Private Sub rbEmployeeSales_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbEmployeeSales.CheckedChanged
		If rbEmployeeSales.Checked Then
			DisableAll()
			ExecuteWebMethod(4)
			cboYearESC.Enabled = True
		End If
	End Sub

	Private Sub cboCategoryName_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cboCategoryName.SelectedIndexChanged
		'If cboCategoryName.SelectedItem IsNot Nothing And cboYearSBC.SelectedItem IsNot Nothing Then
		If blnIsLoaded And rbByCategory.Checked Then
			ExecuteWebMethod(3)
		End If
	End Sub

	Private Sub cboYearSBC_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cboYearSBC.SelectedIndexChanged
		'If cboCategoryName.SelectedItem IsNot Nothing And cboYearSBC.SelectedItem IsNot Nothing Then
		If blnIsLoaded And rbByCategory.Checked Then
			ExecuteWebMethod(3)
		End If
	End Sub

	Private Sub cboYearESC_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cboYearESC.SelectedIndexChanged
		If blnIsLoaded And rbEmployeeSales.Checked Then
			ExecuteWebMethod(4)
		End If
	End Sub

	Private Sub rbBatch_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbBatch.CheckedChanged
		If rbBatch.Checked Then
			DisableAll()
			txtSQL.Enabled = True
			btnExecute.Enabled = True
			txtTime.Text = ""
		Else
			dgvNwind.Visible = True
		End If
	End Sub

	Private Sub btnExecute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecute.Click
		If txtSQL.Text.Length > 0 Then
			ExecuteWebMethod(5)
		End If
	End Sub

	Private Sub txtCustomerID_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtCustomerID.TextChanged
		btnExecuteCustID.Enabled = True
	End Sub

	Private Sub btnExecuteCustID_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecuteCustID.Click
		ExecuteWebMethod(2)
	End Sub
End Class