mainform.vb

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

		Dim rndCust As New Random
		Dim intEmployeeID As Integer
		Dim rndEmplID As New Random
		Dim intShipVia As Integer
		Dim rndShipID As New Random
		Dim decFreight As Decimal
		Dim rndFreight As New Random
		Dim datOrderDate As Date
		Dim datRequiredDate As Date
		Dim datShippedDate As Date
		Dim intAddDays As Integer
		Dim intRowsAffected As Integer
		Dim intOrdersPerDay As Integer = CInt(txtOrdersPerDayStart.Text)
		Dim intDateCtr As Integer
		Dim intOrderID As Integer
		Dim strSQL As String

		'Variables for SalesOrderItems table
		Dim rndItems As New Random
		Dim intQuantity As Integer
		Dim rndQuan As New Random
		Dim intProduct As Integer
		Dim rndProd As New Random
		Dim intTotalItems As Integer
		Dim lngTicks As Long = Now.Ticks
		Dim intOpdCtr As Integer

		Try
			Me.Cursor = Cursors.WaitCursor
			cnNwind.Open()
			For intRow = 0 To intAdd - 1
				'CustomerID
				strCustomerID = alCustIDs(CInt(90 * rndCust.NextDouble)).ToString
				'EmployeeID
				intEmployeeID = CInt(8 * rndEmplID.NextDouble) + 1
				'Order, Required, and ShippedDate
				datOrderDate = datStartDate.AddDays(intAddDays)
				intOpdCtr += 1
				If intRowsPerDayInterval > 0 AndAlso intOpdCtr >= intRowsPerDayInterval Then
					If blnStop Then
						'Stop at the end of a group to prevent discontinuities
						blnStop = False
						Exit For
					End If
					'Increment OrdersPerDay by 1
					intOrdersPerDay += 1
					intOpdCtr = 0
				End If
				intDateCtr += 1
				If intDateCtr >= intOrdersPerDay Then
					'Increment the date by 1
					intAddDays += 1
					intDateCtr = 0
					'Display the current status
					txtDate.Text = datOrderDate.ToShortDateString
					txtOrdersPerDay.Text = intOrdersPerDay.ToString
					txtRowsAdded.Text = (intRow + 1).ToString
                    Application.DoEvents()
				End If

				If Not chkTest.Checked Then
					'Slightly random RequiredDate
					datRequiredDate = datOrderDate.AddDays(10 + intEmployeeID)
					'ShipVia and ShippedDate (slightly random)
					intShipVia = CInt(2 * rndEmplID.NextDouble) + 1
					datShippedDate = datRequiredDate.AddDays(-(5 + intShipVia))
					'Freight (random)
					decFreight = CDec(50 * rndFreight.NextDouble) + 25
					'Create the ship to address from the bill to address
					strSQL = "SELECT CompanyName, Address, City, Region, " + _
					 "PostalCode, Country FROM Customers WHERE CustomerID = '" + strCustomerID + "'"
					cmNwind.CommandText = strSQL
                    'Dim rowCust As SqlRecord = cmNwind.ExecuteRow
                    Dim rowCust As SqlDataReader = cmNwind.ExecuteReader
                    rowCust.Read()
					'Escape single quotes
					Dim strShipName As String = Replace(rowCust(0).ToString, "'", "''")
					Dim strShipAddress As String = Replace(rowCust(1).ToString, "'", "''")
					Dim strShipCity As String = rowCust(2).ToString
					Dim strShipRegion As String = rowCust(3).ToString
					Dim strShipPostalCode As String = rowCust(4).ToString
                    Dim strShipCountry As String = rowCust(5).ToString
                    rowCust.Close()
					'Generate the column-name-qualified INSERT statement
					strSQL = "INSERT SalesOrders (CustomerID, EmployeeID, " + _
					"OrderDate, RequiredDate, ShippedDate, ShipVia, Freight, " + _
					"ShipName, ShipAddress, ShipCity, ShipRegion,  " + _
					"ShipPostalCode, ShipCountry) VALUES ('" + strCustomerID + _
					 "', " + intEmployeeID.ToString + ", '" + datOrderDate.ToShortDateString + _
					 "', '" + datRequiredDate.ToShortDateString + _
					 "', '" + datShippedDate.ToShortDateString + "', " + intShipVia.ToString + _
					 ", " + Format(decFreight, "#0.00") + ", '" + strShipName + _
					 "', '" + strShipAddress + "', '" + strShipCity + "', "
					If strShipRegion.Length = 0 Then
						strSQL += "NULL, "
					Else
						strSQL += "'" + strShipRegion + "', "
					End If
					If strShipPostalCode.Length = 0 Then
						strSQL += "NULL, '"
					Else
						strSQL += "'" + strShipPostalCode + "', '"
					End If
					strSQL += strShipCountry + "'); "
					cmNwind.CommandText = strSQL
					'Execute the insert statement
					intRowsAffected = cmNwind.ExecuteNonQuery
					'Get the OrderID for SalesOrderDetails
					strSQL = "SELECT IDENT_CURRENT('SalesOrders')"
					cmNwind.CommandText = strSQL
					intOrderID = CInt(cmNwind.ExecuteScalar)
				End If
				'Add a random number of SalesOrderItems
				Dim intItem As Integer
				Dim intItems As Integer
				Dim strQuantity As String
				Dim strProductID As String
				Dim strUnitPrice As String
				Dim strDiscount As String
				Dim strProdIDs As String = " "
				strSQL = ""
				'Following adds the correct random number of SaleOrderItems/SalesOrder
				intItems = CInt(CInt(txtAvgItems.Text) * 2 * rndItems.NextDouble) - 1
				If intItems < 1 Then
					intItems = 1
				End If
				For intItem = 0 To intItems
					'Random ProductID (without discontinued products)
					intProduct = CInt(rndProd.NextDouble * 68)
					strProductID = aProducts(intProduct, 0)
					If strProdIDs.Contains("@" + strProductID + ",") Then
						'It's a duplicate; primary key violation, so skip it
					Else
						If chkTest.Checked Then
							intTotalItems += 1
						Else
							strUnitPrice = aProducts(intProduct, 1)
							'Random Quantity
							intQuantity = CInt((rndQuan.NextDouble * 24) + 1)
							strQuantity = intQuantity.ToString
							'Standard quantity Discount
							Select Case intQuantity
								Case Is >= 20
									strDiscount = "0.20"
								Case Is >= 10
									strDiscount = "0.10"
								Case Is >= 5
									strDiscount = "0.05"
								Case Else
									strDiscount = "0.00"
							End Select
							'Insert the SalesOrderItem
							strSQL += "INSERT SalesOrderItems VALUES (" + _
							 intOrderID.ToString + ", " + strProductID + _
							  ", " + strUnitPrice + ", " + strQuantity + _
							  ", " + strDiscount + "); "
							strProdIDs += "@" + strProductID + ", "
						End If
					End If
                    Application.DoEvents()
				Next
				cmNwind.CommandText = strSQL
				If Not chkTest.Checked Then
					'Add the line items as a group
					intTotalItems += cmNwind.ExecuteNonQuery
				End If

				'Update the progress bar
				pbRows.Value = intRow
                Application.DoEvents()
			Next intRow
			cnNwind.Close()
			btnStopAdding.Enabled = False
			'Display the final values
			txtDate.Text = datOrderDate.ToShortDateString
			txtOrdersPerDay.Text = intOrdersPerDay.ToString
			txtRowsAdded.Text = intRow.ToString
			Me.Cursor = Cursors.Default
			If Not chkTest.Checked Then
				'Display the results message box
				lngTicks = Now.Ticks - lngTicks
				btnTruncate.Enabled = True
				'Reset the initial values
				GetInitialValues(True)
				Dim intSeconds As Integer = CInt(lngTicks / 10000000)
				Dim strMsg As String = Format(intRow, "#,##0") + " SalesOrders rows and " + _
				 Format(intTotalItems, "#,##0") + " SalesOrderItems added in " + _
				 Format(intSeconds, "#,##0") + " seconds  = " + _
				 Format((intRow + intTotalItems) / intSeconds, "#,##0") + " rows/second."
				MsgBox(strMsg, MsgBoxStyle.Information, "SalesOrders Fill Operation Terminated")
			End If
		Catch exc As Exception
			Me.Cursor = Cursors.Default
			MsgBox(exc.Message + exc.StackTrace, MsgBoxStyle.Exclamation, "Exception During SalesOrders Addition")
		Finally
			Me.Cursor = Cursors.Default
			cnNwind.Close()
		End Try
	End Sub

	Private Sub btnStopAdding_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStopAdding.Click
		'Still might need to click twice to stop adding orders
        Application.DoEvents()
		blnStop = True
        Application.DoEvents()
	End Sub

	Private Sub btnTruncate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTruncate.Click
		Dim strMsg As String = "You can truncate or drop the 'SalesOrders' and 'SalesOrderItems' tables. " + vbCrLf + vbCrLf + _
		 "If you want to preserve your changes to the structure of the tables, click Yes to truncate " + _
		 "the tables, which might take a few minutes or longer, depending on the number of records you added. " + _
		 "New OrderID values will start with the last value plus 1." + vbCrLf + vbCrLf + _
		 "Otherwise, click No to drop and recreate the tables or Cancel to preserve them."
		Dim intChoice As Integer
		intChoice = MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNoCancel, "Truncate or Recreate the SalesOrders and SalesOrderItems Tables")
		If intChoice = MsgBoxResult.No Then
			CreateTables(False)
			ResetForm()
		ElseIf intChoice = MsgBoxResult.Yes Then
			Try
				Me.Cursor = Cursors.WaitCursor
                Application.DoEvents()
				Dim strSQL As String = "TRUNCATE TABLE SalesOrderItems"
				cmNwind.CommandText = strSQL
				cnNwind.Open()
				Dim intRecsAffected As Integer = cmNwind.ExecuteNonQuery
				'Nocando: Has foreign key constraints
				'strSQL = "TRUNCATE TABLE SalesOrders"
				strSQL = "DELETE FROM SalesOrders"
				cmNwind.CommandText = strSQL
				cmNwind.CommandTimeout = 1000
				intRecsAffected = cmNwind.ExecuteNonQuery
				cnNwind.Close()
				Me.Cursor = Cursors.Default
				ResetForm()
			Catch exc As Exception
				Me.Cursor = Cursors.Default
				strMsg = exc.Message + vbCrLf + vbCrLf
				strMsg += "If you recieve a timeout error, execute 'DELETE FROM Sales Orders' " + _
				 "with an SQL script. Executing the query from SQL Server Management Studio " + _
				 "or SQL Express Manager probably will result in the same timeout error."
				MsgBox(strMsg, MsgBoxStyle.Exclamation, "Error Truncating or Deleting Table")
			Finally
				cnNwind.Close()
				Me.Cursor = Cursors.Default
			End Try
		End If
	End Sub

	Private Sub ResetForm()
		'Set original values
		Me.Height = 230
		SalesOrdersDataNavigator.Visible = False
		pbRows.Value = 0
        Application.DoEvents()
		txtEndDate.Text = Today.ToShortDateString
		GetInitialValues(True)
		txtOrdersPerDayStart.Text = "50"
		txtOrdersPerDayEnd.Text = "75"
		txtAddRows.Text = "10000"
		txtAvgItems.Text = "4"
		txtRowsAdded.Text = ""
		txtOrdersPerDay.Text = ""
		txtDate.Text = ""
	End Sub

	Private Sub chkTest_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkTest.CheckedChanged
		If chkTest.Checked Then
			'txtStartDate.Text = Today.ToShortDateString
			btnStartAdding.Enabled = False
			lblEndDate.Text = "Actual End Date:"
		Else
			'txtStartDate.Text = strStartDate
			'txtRowCount.Text = strRowCount
			btnStartAdding.Enabled = True
			lblEndDate.Text = "Calculated End Date:"
		End If
	End Sub

	Private Sub chkToolTips_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkToolTips.CheckedChanged
		If chkToolTips.Checked Then
			ttSalesOrders.Active = True
		Else
			ttSalesOrders.Active = False
		End If
	End Sub
End Class