Multithreading text figures

Figure 4 frmCustomer Subroutines

Subroutine Name
Description

cmdFind_Click
Find a single customer record from the database calling the LookupCustomerByEmail method on the Customer object.

cmdSearch_Click
Open the frmCustomerSearch to allow user to select a customer from a list box.

cmdClear_Click
Clear all fields on a form.

cmdAdd_Click
Add a new customer to the database using the Add method on the Customer object.

cmdSave_Click
Save an existing customer using the Update method on the Customer object.

cmdExit_Click
Exit and end application

FillFields
Fill the fields on the form with the data from the recordset returned by the Find method.

ClearFields
Clear all the fields on the form.

FindCustomer
Find a customer in the database using the Find method on the Customer object.

Form_KeyDown
Executes code that implements the shortcut keys for the command buttons on the form. The KeyPreview property on the form is set to True causing the shortcuts (Alt-I) to be processed in this method. We did this because we used graphics on our command buttons without captions.

Figure 6 frmCustomerSearch Subroutines

cmdSearch_Click
Search the customer database finding all last names matching the selection entered by using the LookupCustomerByLastName method on the Customer object.

CmdSelect_Click
Select a customer record from the list box and fill the customer form with the customer record by using the Find method on the Customer object.

cmdExit_Click
Hide the frmCustomerSearch form

Form_KeyDown
Executes code that implements the shortcut keys for the command buttons on the form. The KeyPreview property on the form is set to True causing the shortcuts (Alt-I) to be processed in this method. We did this because we used graphics on our command buttons without captions.

Figure 7 Customer Maintenance Client

CustomerMod.bas

 VERSION 5.00
 ' we always return the same error number
 Public Const ERROR_NUMBER = vbObjectError + 0 
 Public Const strDSN = "Classified.dsn"
 Public g_strEmail as String
 
 frmCustomer.frm
 Option Explicit
 Dim objCustomer As MTS_Customers.Customers
 
 Private Sub Form_Load()
    
     On Error GoTo ErrorHandler
     
     Set objCustomer = CreateObject("MTS_Customers.Customers")
     
     Exit Sub
 
 ErrorHandler:
 
     cmdExit_Click
     MsgBox "An error occurred in creating the Customer Component."
 
 End Sub
 
 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 
     If Shift <> vbAltMask Then
         Exit Sub
     Else
         Select Case KeyCode
             Case vbKeyI
                 cmdFind_click
             Case vbKeyR
                 cmdSearch_Click
             Case vbKeyC
                 cmdClear_Click
             Case vbKeyA
                 cmdAdd_Click
             Case vbKeyS
                 cmdSave_Click
             Case vbKeyX
                 cmdExit_Click
         End Select
     End If
     
 End Sub
 
 Private Sub cmdSearch_Click()
 
     On Error GoTo ErrorHandler
     
     frmCustomerSearch.Show vbModal, Me
     
     Exit Sub
     
 ErrorHandler:
 
     MsgBox "An error occurred loading the customer search form."
     
 End Sub
 
 Private Sub cmdFind_click()
 
     On Error GoTo ErrorHandler
 
     If txtEmail.Text = "" Then
         MsgBox "ERROR: Email is required to lookup customer.", , Me.Caption
         txtEmail.SetFocus
     Else
         FindCustomer
         txtEmail.SetFocus
     End If
     
     Exit Sub
     
 ErrorHandler:
     
     MsgBox "An error occurred in finding the customer."
     
 End Sub
 
 Private Sub cmdClear_Click()
     ClearFields
 End Sub
 
 Private Sub cmdAdd_Click()
     
     On Error GoTo ErrorHandler
     
     objCustomer.Add strDSN, txtEmail, txtLastName, 
                     txtFirstName, txtAddress, txtCity, 
                     txtState, txtPostalCode, txtPhoneNumber
     txtEmail.SetFocus
     MsgBox "Customer record has been added.", , Me.Caption
     
     Exit Sub
 
 ErrorHandler:
 
     MsgBox "ERROR: Your record was not added. This customer may already exist.",
             , Me.Caption
     txtEmail.SetFocus
 
 End Sub
 
 Private Sub cmdSave_Click()
 
     On Error GoTo ErrorHandler
     
     If txtEmail <> "" Then
         objCustomer.Update strDSN, txtEmail, txtLastName, 
                            txtFirstName, txtAddress, txtCity, 
                            txtState, txtPostalCode, txtPhoneNumber
         txtEmail.SetFocus
         MsgBox "Customer record has been updated.", , Me.Caption
     Else
         Err.Raise ERROR_NUMBER, "Email is required."
     End If
     
     Exit Sub
 
 ErrorHandler:
     
     MsgBox "ERROR: " & Err.Description & ". Customer record was not updated.", 
            , Me.Caption
     txtEmail.SetFocus
 
 End Sub
 
 Private Sub cmdExit_Click()
     End
 End Sub
 
 Public Sub FillFields(rsCustomer As ADODB.Recordset)
 
     txtEmail.Text = rsCustomer!Email
     txtLastName.Text = rsCustomer!LastName
     txtFirstName.Text = rsCustomer!FirstName
     txtAddress.Text = rsCustomer!Address
     txtCity.Text = rsCustomer!City
     txtState.Text = rsCustomer!State
     txtPostalCode.Text = rsCustomer!PostalCode
     txtPhoneNumber.Text = rsCustomer!PhoneNumber
 
 End Sub
 
 Private Sub ClearFields()
 
     txtEmail.Text = ""
     txtLastName.Text = ""
     txtFirstName.Text = ""
     txtAddress.Text = ""
     txtCity.Text = ""
     txtState.Text = ""
     txtPostalCode.Text = ""
     txtPhoneNumber.Text = ""
 
 End Sub
 
 Public Sub FindCustomer()
     
     On Error GoTo ErrorHandler
     
     Dim rsCustomer As ADODB.Recordset
     Set rsCustomer = 
        objCustomer.LookupCustomerByEMail(strDSN, txtEmail.Text)
     If rsCustomer.EOF = True And rsCustomer.BOF = True Then
         MsgBox "ERROR: No record was found.", , Me.Caption
         Dim strEmail As String
         strEmail = txtEmail.Text
         ClearFields
         txtEmail.Text = strEmail
     Else
         FillFields rsCustomer
     End If
     
     Exit Sub
 
 ErrorHandler:
 
     MsgBox "Error in finding customer."
     
 End Sub
 FrmCustomerSearch.frm
 
 Option Explicit
 Dim arrCustomerEmail() As String
 Dim objCustomer As MTS_Customers.Customers
 
 Private Sub cmdSelect_Click()
 
     On Error GoTo ErrorHandler
 
     If lstCustomers.ListIndex < 0 Then
         MsgBox "No customer has been selected."
         txtSearch.SetFocus
         Exit Sub
     End If
     
     g_strEmail = arrCustomerEmail(lstCustomers.ListIndex)
     Me.Hide
     frmCustomers.Show
     frmCustomers.txtEmail.SetFocus
     
     Exit Sub
     
 ErrorHandler:
     
     MsgBox "An error occurred in selecting the customer record"
 
 End Sub
 
 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
     
     If Shift <> vbAltMask Then
         Exit Sub
     Else
         Select Case KeyCode
             Case vbKeyR
                 cmdSearch_Click
             Case vbKeyX
                 cmdExit_Click
         End Select
     End If
     
 End Sub
 
 Private Sub cmdExit_Click()
     Me.Hide
 End Sub
 
 Private Sub cmdSearch_Click()
 
     On Error GoTo ErrorHandler
     
     Dim strListData As String
     Dim rsCustomer As ADODB.Recordset
     
         lstCustomers.Clear
         Set rsCustomer = 
            objCustomer.LookupCustomerByLastName
              (strDSN, txtSearch.Text)
         
         Dim i  As Integer
         i = 0
         Do Until rsCustomer.EOF
             lstCustomers.AddItem rsCustomer!LastName & ", 
                    " & rsCustomer!FirstName
             ReDim Preserve arrCustomerEmail(i)
             arrCustomerEmail(i) = rsCustomer!Email
             i = i + 1
             rsCustomer.MoveNext
         Loop
         
         Exit Sub
         
 ErrorHandler:
     
         MsgBox "An error occurred in search for customer."
         
 End Sub
 
 Private Sub Form_Load()
     
     On Error GoTo ErrorHandler
     
     Set objCustomer = CreateObject("MTS_Customers.Customers")
     
     Exit Sub
 
 ErrorHandler:
 
     cmdExit_Click
     MsgBox "An error occurred in creating the Customer Component."
 
 End Sub

Figure 8 Customer Object Methods

Method Name
Description

LookupCustomerByLastName
Given all or part of a customer last name, return a customer recordset containing all matching records found.

LookupCustomerByEMail
Given a customer email address, return a customer recordset containing one customer.

Add
Add a customer record.

Update
Update a customer record.

Figure 9 LookupCustomerByLastName Method


 Public Function LookupCustomerByLastName
   (ByVal fileDSN As String, ByVal vLastName) As Variant   
     Dim m_objContext As ObjectContext
     Set m_objContext = GetObjectContext
     On Error GoTo ErrorHandler
 
 ' Get customer information
     Dim rsCustomer As New ADODB.Recordset
     Dim strSQL As String
     strSQL = "SELECT FULLNAME = (RTrim(LastName) + ', 
              ' + RTrim(FirstName)),LastName, FirstName, 
              Address, City, State, PostalCode, PhoneNumber, 
              EMail FROM Customers Where LastName Like '" & 
              vLastName & "%' ORDER BY FULLNAME For Browse"
     rsCustomer.CursorLocation = adUseClientBatch
     rsCustomer.Open strSQL, "FILEDSN=" & fileDSN
 
     ' Cleanup object on the way out
     objContext.SetComplete
     
     Set LookupCustomerByLastName = rsCustomer   
     Exit Function
     
 ErrorHandler:   
     ' Cleanup object on the way out
     objContext.SetAbort
     Err.Raise Number:=ERROR_NUMBER, 
       Source:="MTS_Customers.Customers.LookupCustomerByLastName", 
       Description:=Err.Description
         
 End Function

Figure 10 LookupCustomerByEMail Method


 Public Function LookupCustomerByEMail
   (ByVal fileDSN As String, ByVal vEmail) As ADODB.Recordset
     
     
     Dim objContext As ObjectContext
     Set objContext = GetObjectContext
     
     On Error GoTo ErrorHandler
     
     ' Get customer information
     Dim rsCustomer As New ADODB.Recordset
     Dim strSQL As String
     
     strSQL = "Select * from Customers where Email ='" & vEmail & "'"
     rsCustomer.CursorLocation = adUseClientBatch
     rsCustomer.Open strSQL, "FILEDSN=" & fileDSN
     
     ' Cleanup object on the way out
     objContext.SetComplete
     
     ' all went well -- return the customer
     Set LookupCustomerByEMail = rsCustomer
     
     Exit Function
     
 ErrorHandler:
     
     ' Cleanup object on the way out
     objContext.SetAbort
     Err.Raise Number:=ERROR_NUMBER, 
               Source:="MTS_Customers.Customers.LookupCustomerByEMail", 
               Description:=Err.Description
     
 End Function

Figure 11 Adding a Customer


 Public Sub Add(ByVal fileDSN, ByVal strEMail As String, 
                ByVal strLastName As String, 
                ByVal strFirstName As String, 
                ByVal strAddress As String, 
                ByVal strCity As String, ByVal strState As String, 
                ByVal strPostalCode As String, ByVal strPhone As String)
     
     Dim objContext As ObjectContext
     Set objContext = GetObjectContext
     
     On Error GoTo ErrorHandler
     Dim strSQL As String
     Dim Conn As New ADODB.Connection
     strSQL = "INSERT Customers(Email, LastName, FirstName, 
              'Address, City, State, PostalCode, PhoneNumber) 
              VALUES ('" & strEMail & "', '" & strLastName & "', 
              '" & strFirstName & "', '" & strAddress & "', 
              '" & strCity & "', '" & strState & "', 
              '" & strPostalCode & "', '" & strPhone & "')"
     Conn.Open "FILEDSN=" & fileDSN, "", ""
     Conn.Execute strSQL
     
     objContext.SetComplete
     
     Exit Sub
 
 ErrorHandler:
     
     ' Cleanup object on the way out
     objContext.SetAbort
     Err.Raise Number:=ERROR_NUMBER, 
               Source:="MTS_Customers.Customers.Customers.Add", 
               Description:=Err.Description
 
 End Sub

Figure 12 Update Method


 Public Sub Update(ByVal fileDSN, ByVal strEMail As String, 
                   ByVal strLastName As String, 
                   ByVal strFirstName As String, 
                   ByVal strAddress As String, 
                   ByVal strCity As String, 
                   ByVal strState As String, 
                   ByVal strPostalCode As String, 
                   ByVal strPhone As String)
     
     Dim objContext As ObjectContext
     Set objContext = GetObjectContext
     
     On Error GoTo ErrorHandler
 
     Dim strSQL As String
     Dim Conn As New ADODB.Connection
     strSQL = "Update Customers Set " & "LastName = '" &
              strLastName & "', " & "FirstName = '" & 
              strFirstName & "', " & "Address = '" & 
              strAddress & "', " & "City = '" & strCity & 
              "', " & "State = '" & strState & "', " & 
              "PostalCode = '" & strPostalCode & "', " & 
              "PhoneNumber = '" & strPhone & "' " & 
              "Where Email = '" & strEMail & "'"
     Conn.Open "FILEDSN=" & fileDSN, "", ""
     Conn.Execute strSQL
     
     objContext.SetComplete
     
     Exit Sub
 
 ErrorHandler:
     
     ' Cleanup object on the way out
     objContext.SetAbort
     Err.Raise Number:=ERROR_NUMBER, 
               Source:="MTS_Customers.Customers.Customers.Update", 
               Description:=Err.Description
 
 End Sub

Subroutine Name	Description
cmdFind_Click	Find a single customer record from the database calling the LookupCustomerByEmail method on the Customer object.
cmdSearch_Click	Open the frmCustomerSearch to allow user to select a customer from a list box.
cmdClear_Click	Clear all fields on a form.
cmdAdd_Click	Add a new customer to the database using the Add method on the Customer object.
cmdSave_Click	Save an existing customer using the Update method on the Customer object.
cmdExit_Click	Exit and end application
FillFields	Fill the fields on the form with the data from the recordset returned by the Find method.
ClearFields	Clear all the fields on the form.
FindCustomer	Find a customer in the database using the Find method on the Customer object.
Form_KeyDown	Executes code that implements the shortcut keys for the command buttons on the form. The KeyPreview property on the form is set to True causing the shortcuts (Alt-I) to be processed in this method. We did this because we used graphics on our command buttons without captions.

cmdSearch_Click	Search the customer database finding all last names matching the selection entered by using the LookupCustomerByLastName method on the Customer object.
CmdSelect_Click	Select a customer record from the list box and fill the customer form with the customer record by using the Find method on the Customer object.
cmdExit_Click	Hide the frmCustomerSearch form
Form_KeyDown	Executes code that implements the shortcut keys for the command buttons on the form. The KeyPreview property on the form is set to True causing the shortcuts (Alt-I) to be processed in this method. We did this because we used graphics on our command buttons without captions.

Method Name	Description
LookupCustomerByLastName	Given all or part of a customer last name, return a customer recordset containing all matching records found.
LookupCustomerByEMail	Given a customer email address, return a customer recordset containing one customer.
Add	Add a customer record.
Update	Update a customer record.