VB icon

Build a Stateless Class

Email
Submitted on: 1/2/2015 7:46:00 PM
By: Mark Freni (from psc cd)  
Level: Not Given
User Rating: By 3 Users
Compatibility: VB 5.0, VB 6.0
Views: 1455
 
     The example shows how to create a "Stateless" Class. By sending and receiving UDT's and disconnected recordsets you will find a significant increase in speed with your objects in a 3 tiered application. If you use collections, each time you get/set a property you make a network call. This method reduces network traffic.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Build a Stateless Class
' Description:The example shows how to create a "Stateless" Class. By sending and receiving UDT's and disconnected recordsets you will find a significant increase in speed with your objects in a 3 tiered application. If you use collections, each time you get/set a property you make a network call. This method reduces network traffic.
' By: Mark Freni (from psc cd)
'
' Inputs:I declare a Public Type in the class module. In the user interface you need to declare the type in the procedure before you use it. Example:
' Dim udt as UdtTest
'
' Returns:Each of the functions return a value
'
' Assumes:The user needs to understand UDT's, ADO, and Classes
'**************************************

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'FORM cTest
'AUTHOR Mark Freni
'DESC Class to hold tblTest Functions,
' procedures, and variables
'FUNCTIONS GetList, Update, Add 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit
 Public Type UdtTest
	' If the table has many fields this becomes
	' very convenient
 TestID As Long
 Field_1 As String
 Field_2 As Integer
 Active As Boolean
 End Type
 
Public Function GetList(Optional ByVal _
 ReturnAll As Boolean = False) As ADODB.Recordset
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function : GetList
' Purpose : Provide a disconnected recordset of tblTest 
' Author : Mark Freni
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 On Error GoTo FUNCT_ERR
 Dim conn As New ADODB.Connection
 Dim strSql As String
 Dim rst As New ADODB.Recordset
 
 strSql = "SELECT * FROM tblTest"
 
 If ReturnAll Then
 strSql = strSql & " Where Active"
 End If
 
 With conn
 .CursorLocation = adUseClient
 .ConnectionString = strConnect
 End With
 
 conn.Open
 
 With rst
 .CursorLocation = adUseClient
 .LockType = adLockBatchOptimistic
 .CursorType = adOpenKeyset
 End With
 
 '~OPEN THE RECORDSET
 rst.Open strSql, conn
 
 Set rst.ActiveConnection = Nothing
 Set GetList = rst
 
FUNCT_EXIT:
 Set conn = Nothing
 Exit Function
 
FUNCT_ERR:
 Err.Raise Err.Number, Err.Source, Err.Description
 Resume FUNCT_EXIT
End Function
Public Function Add(udt As UdtTest) As Boolean
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function : Add
' Purpose : Add a Record to tblTest 
' Author : Mark Freni
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 On Error GoTo FUNCT_ERR
 Dim conn As New ADODB.Connection
 Dim rst As New ADODB.Recordset
 Dim strSql As String
 
 conn.Open strConnect
 rst.CursorLocation = adUseClient
 rst.CursorType = adOpenKeyset
 rst.LockType = adLockBatchOptimistic
 
 rst.Open "tblTest", conn
 rst.AddNew
 
 With udt
	' I don't need to worry about setting quotes
	' using this method, the UDT tells the 
	' recordset what datatypes the values are
 If Len(.Field_1) > 0 then rst("Field_1") = .Field_1
 If Len(.Field_2) > 0 then rst("Field_2") = .Field_2
 End With
 rst.UpdateBatch
 
 If rst.STATE = 1 Then rst.Close
 conn.Close
 
 Add = True
 
FUNCT_EXIT:
 Set conn = Nothing
 Set rst = Nothing
 Exit Function
FUNCT_ERR:
 Add = False
 Err.Raise Err.Number, Err.Source, Err.Description
 Resume FUNCT_EXIT
 
End Function
Public Function Update(udt As UdtTest) As Boolean
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function : Update
' Purpose : Update a Record in tblTest 
' Author : Mark Freni
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 On Error GoTo FUNCT_ERR
 Dim conn As New ADODB.Connection
 Dim rst As New ADODB.Recordset
 Dim strSql As String
 conn.Open strConnect
 rst.CursorLocation = adUseServer
 rst.LockType = adLockBatchOptimistic
 
 strSql = "SELECT * FROM tblTest WHERE TestID =" & udt.TestID
 rst.Open strSql, conn
 
 If rst.EOF Then
 Update = False
 GoTo FUNCT_EXIT
 End If
 
 With udt
 If Len(.Field_1) > 0 Then rst("Field_1") = .Field_1
 If Len(.Field_2) > 0 Then rst("Field_2") = .Field_2
 If .Active Then rst("Active") = .Active
 End With
 rst.UpdateBatch
 If rst.STATE = 1 Then rst.Close
 conn.Close
 
 Update = True
 
FUNCT_EXIT:
 Set conn = Nothing
 Exit Function
FUNCT_ERR:
 Err.Raise Err.Number, Err.Source, Err.Description
 Update = False
 Resume FUNCT_EXIT
 
End Function


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.