www.pudn.com > sqlserverdbfz.rar > frmCLASSterSampleMain.frm
VERSION 5.00
Begin VB.Form frmCLASSterSampleMain
Caption = "CLASSter Sample"
ClientHeight = 7410
ClientLeft = 60
ClientTop = 345
ClientWidth = 10110
LinkTopic = "Form1"
ScaleHeight = 7410
ScaleWidth = 10110
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdTestConnection
Caption = "Test"
Height = 330
Left = 8730
TabIndex = 29
Top = 525
Width = 1200
End
Begin VB.TextBox txtConnectString
Height = 330
Left = 1635
TabIndex = 28
Text = "Driver=SQL Server;UID=sa;PWD=;Server=; Database=Northwind"
Top = 555
Width = 7080
End
Begin VB.Frame Frame5
Caption = "Demo 3: Using ExecSPbyName method"
ForeColor = &H00FF0000&
Height = 810
Left = 135
TabIndex = 25
Top = 3510
Width = 9870
Begin VB.CommandButton cmdGetSalesByYear
Caption = "Get Sales By Year"
Height = 330
Left = 7485
TabIndex = 26
Top = 180
Width = 2280
End
Begin VB.Label Label11
Caption = "App executes [Sales by year] stored procedure using ExecSPbyName method of CNorthwindDB class with dates in 1998 "
Height = 465
Left = 105
TabIndex = 27
Top = 255
Width = 7245
End
End
Begin VB.Frame Frame4
Caption = "Demo 5: Using transactions"
ForeColor = &H00FF0000&
Height = 1215
Left = 120
TabIndex = 18
Top = 6090
Width = 9870
Begin VB.OptionButton optAbort
Caption = "Update and Abort"
Height = 255
Left = 4125
TabIndex = 24
Top = 270
Width = 1875
End
Begin VB.OptionButton optCommit
Caption = "Update and Commit"
Height = 300
Left = 2235
TabIndex = 23
Top = 255
Value = -1 'True
Width = 1815
End
Begin VB.TextBox txtCustID4
Height = 330
Left = 1215
TabIndex = 20
Text = "ALFKI"
Top = 255
Width = 855
End
Begin VB.CommandButton cmdIncCustOrders
Caption = "Increment All Freights"
Height = 330
Left = 7455
TabIndex = 19
Top = 210
Width = 2310
End
Begin VB.Label Label10
Caption = "Customer ID:"
Height = 300
Left = 195
TabIndex = 22
Top = 315
Width = 1110
End
Begin VB.Label Label9
Caption = $"frmCLASSterSampleMain.frx":0000
Height = 540
Left = 90
TabIndex = 21
Top = 600
Width = 9645
End
End
Begin VB.Frame Frame3
Caption = "Demo 4: Using Batch Methods, multiple recordsets "
ForeColor = &H00FF0000&
Height = 1650
Left = 120
TabIndex = 11
Top = 4395
Width = 9870
Begin VB.TextBox txtBatch
BeginProperty Font
Name = "Courier New"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = 1365
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 16
Top = 930
Width = 8340
End
Begin VB.TextBox txtCustID3
Height = 330
Left = 1215
TabIndex = 13
Text = "ALFKI"
Top = 255
Width = 855
End
Begin VB.CommandButton cmdGetCustInfo
Caption = "Get Customer Info"
Height = 330
Left = 7485
TabIndex = 12
Top = 165
Width = 2310
End
Begin VB.Label Label1
Caption = "Executed batch:"
Height = 300
Left = 135
TabIndex = 17
Top = 915
Width = 1560
End
Begin VB.Label Label8
Caption = "Customer ID:"
Height = 300
Left = 195
TabIndex = 15
Top = 315
Width = 1110
End
Begin VB.Label Label7
Caption = "Enter existing customer ID to see his information and his orders in one XML message. "
Height = 300
Left = 180
TabIndex = 14
Top = 585
Width = 9480
End
End
Begin VB.Frame Frame2
Caption = "Demo 2: Executing SQLs, getting server errors. "
ForeColor = &H00FF0000&
Height = 975
Left = 135
TabIndex = 6
Top = 2460
Width = 9885
Begin VB.TextBox txtSQL
Height = 330
Left = 720
TabIndex = 8
Text = "SELECT * FROM Customers"
Top = 270
Width = 4980
End
Begin VB.CommandButton cmdExecuteSQL
Caption = "Execute"
Height = 330
Left = 7470
TabIndex = 7
Top = 255
Width = 2310
End
Begin VB.Label Label6
Caption = "SQL:"
Height = 300
Left = 165
TabIndex = 10
Top = 300
Width = 495
End
Begin VB.Label Label5
Caption = "Enter SQL statement to execute. Enter invalid SQL to generate server errors (for ex. enter invalid field names instead of *). "
Height = 270
Left = 90
TabIndex = 9
Top = 630
Width = 9630
End
End
Begin VB.Frame Frame1
Caption = "Demo 1: Executing SPs, using XML methods, handling errors and exceptions"
ForeColor = &H00FF0000&
Height = 1335
Left = 150
TabIndex = 1
Top = 1035
Width = 9885
Begin VB.CommandButton cmdGetCustOrders
Caption = "Get Customer Orders"
Height = 330
Left = 7470
TabIndex = 3
Top = 210
Width = 2280
End
Begin VB.TextBox txtCustID
Height = 330
Left = 1215
TabIndex = 2
Text = "ALFKI"
Top = 255
Width = 855
End
Begin VB.Label Label4
Caption = $"frmCLASSterSampleMain.frx":00EA
Height = 615
Left = 75
TabIndex = 5
Top = 600
Width = 9675
End
Begin VB.Label Label3
Caption = "Customer ID:"
Height = 300
Left = 195
TabIndex = 4
Top = 315
Width = 1110
End
End
Begin VB.Label Label12
Caption = "Connection string:"
Height = 300
Left = 195
TabIndex = 30
Top = 600
Width = 1395
End
Begin VB.Label Label2
Caption = $"frmCLASSterSampleMain.frx":0209
Height = 525
Left = 135
TabIndex = 0
Top = 90
Width = 9825
End
End
Attribute VB_Name = "frmCLASSterSampleMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Sample application demonstrating CNorthwindDB database class generated by CLASSter(tm)
'from URFIN JUS (www.urfinjus.net)
Option Explicit
' Error action for event handlers. Default value EA_DEFAULT shouldn't be used
' as it reraises errors
Const EA_HANDLERS = EA_ADVANCED
Private Sub cmdTestConnection_Click()
Dim Cn As ADODB.Connection
On Error GoTo errHandler
Set Cn = New ADODB.Connection
Cn.ConnectionTimeout = 5
Cn.Open txtConnectString.Text
MsgBox "Connection tested successfully."
Exit Sub
errHandler:
MsgBox Err.Description, , "Error"
End Sub
'Demo 1: Executing stored procedures, handling errors, using exceptions =========================
Private Sub cmdGetCustOrders_Click()
On Error GoTo errHandler
CheckCustID txtCustID.Text
GetCustOrders txtCustID.Text
Exit Sub
errHandler:
'At top level (in methods like button click handlers) we should decide what to do with error.
'First we call ErrorIn again to add this method to call stack. Then HandleError shows the error to user.
'HandleError shows error description either in MsgBox or in frm0Error (when it contains
' extended error information).
ErrorIn "frmCLASSterSampleMain.cmdGetCustOrders_Click", , EA_HANDLERS
HandleError
End Sub
'Demonstrates using of exceptions. "Check" sub is a handy method that raises specified
'error if condition is false. As we use EXC_GENERAL as error number, ErrorIn in error
'handler recognizes it as exception, and simply reraises it, without building extended
'error information. At top level of call stack (in button click handler) HandleError
'will be called. HandleError will recognize that it is exception, and will show
'error description (message we provide to Check) in message box.
Private Sub CheckCustID(ByVal CustID As String)
On Error GoTo errHandler
Check Trim$(CustID) <> "", EXC_GENERAL, "Customer ID may not be empty."
Exit Sub
errHandler:
ErrorIn "frmCLASSterSampleMain.CheckCustID(CustID)", CustID
End Sub
Private Sub GetCustOrders(ByVal CustID As String)
Dim DB As CNorthwindDB
On Error GoTo errHandler
Set DB = New CNorthwindDB
DB.ConnectionString = txtConnectString.Text
DB.ExecCustOrderHist CustID
'Here we demonstrate raising error in code. ERR_GENERAL will be treated as error,
' not exception, so ErrorIn will start to build extended error information.
Check DB.RecordCount > 0, ERR_GENERAL, "Orders not found for Customer: " & txtCustID.Text
frm0XMLView.xml = DB.xmlGetRecordsetExt("Orders", "Order")
Exit Sub
errHandler:
ErrorIn "frmCLASSterSampleMain.cmdGetCustOrders(CustID)", CustID
End Sub
'Demo 2: Executing SQLs, showing server errors===================================================
Private Sub cmdExecuteSQL_Click()
On Error GoTo errHandler
Dim DB As CNorthwindDB
On Error GoTo errHandler
Set DB = New CNorthwindDB
DB.ConnectionString = txtConnectString.Text
DB.BeginTransaction
DB.ExecSQL txtSQL.Text
frm0XMLView.xml = DB.xmlGetRecordsetExt("Customers", "Customer")
Exit Sub
errHandler:
ErrorIn "frmCLASSterSampleMain.cmdExecuteSQL_Click", , EA_HANDLERS
HandleError
End Sub
'Demo 3: Using ExecSPbyName method ===================================================
Private Sub cmdGetSalesByYear_Click()
On Error GoTo errHandler
Dim DB As CNorthwindDB
On Error GoTo errHandler
Set DB = New CNorthwindDB
DB.ConnectionString = txtConnectString.Text
DB.ExecSPbyName "[Sales by Year]", PRM_SALESBYYEAR, Array(CDate("01/01/1998"), CDate("01/01/1999"))
frm0XMLView.xml = DB.xmlGetRecordsetExt("Sales", "Sale")
Exit Sub
errHandler:
ErrorIn "frmCLASSterSampleMain.cmdGetSalesByYear_Click", , EA_HANDLERS
HandleError
End Sub
'Demo 4: Using Batch methods, multiple recordsets =============================================
Private Sub cmdGetCustInfo_Click()
Dim DB As CNorthwindDB, CustID As String
On Error GoTo errHandler
CustID = Trim$(txtCustID3.Text)
CheckCustID CustID
Set DB = New CNorthwindDB
With DB
.ConnectionString = txtConnectString.Text
.BatchBegin
.ExecSQL "SELECT * FROM Customers WHERE CustomerID='" & CustID & "'"
.ExecCustOrderHist CustID
.BatchExec
Check .RecordCount > 0, ERR_GENERAL, "Orders not found for Customer " & txtCustID.Text
txtBatch.Text = .BatchText
frm0XMLView.xml = .xmlGetAllRecordsets("CustomerInfo", ",Orders", "Customer,Order")
End With
Exit Sub
errHandler:
'Here we demonstrate showing additional variables (other than method arguments) in extended
'error message
ErrorIn "frmCLASSterSampleMain.cmdGetCustInfo_Click", , EA_HANDLERS, , "CustID", CustID
HandleError
End Sub
'Demo 5 ===========================================================================================
Private Sub cmdIncCustOrders_Click()
Dim DB As CNorthwindDB, CustID As String
On Error GoTo errHandler
CustID = Trim$(txtCustID4.Text)
CheckCustID CustID
Set DB = New CNorthwindDB
DB.ConnectionString = txtConnectString.Text
DB.BeginTransaction
DB.ExecSQL "Update Orders SET Freight=Freight + 1 " & _
" WHERE CustomerID='" & CustID & "'"
If optCommit.Value Then DB.SetComplete Else DB.SetAbort
DB.ExecSQL "Select * from Orders WHERE CustomerID='" & CustID & "'"
frm0XMLView.xml = DB.xmlGetRecordsetExt("Orders", "Order")
Exit Sub
errHandler:
ErrorIn "frmCLASSterSampleMain.cmdIncCustOrders_Click", , EA_HANDLERS
HandleError
End Sub
'Utilities ============================================================================
Private Sub Form_Unload(Cancel As Integer)
Unload frm0Error
Unload frm0XMLView
End Sub
'HandleError shows error description either in MsgBox or in frm0Error (when it contains
' extended error information).
Private Sub HandleError()
If IsException(Err.Number) Then
MsgBox Err.Description, vbOKOnly, "Exception"
Else
frm0Error.ErrorMessage = Err.Description
End If
End Sub