Sample Codes (Visual Basic)

  • Article
Archived content. No warranty is made as to technical accuracy. Content may contain URLs that were valid when originally published, but now link to sites or pages that no longer exist.
On This Page

Post Method, Step1 (Visual Basic)
Post Method, Step2 (Visual Basic)
Post Method, Step3 (Visual Basic)
Perform Method, Step4 (Visual Basic)
GetNextReceipt Method, Step5 (Visual Basic)
Perform Method, Step5 (Visual Basic)
StatefulPerform Method, Step6 (Visual Basic)
Update Method, Step7 (Visual Basic)
GetNextReceipt Method, Step7 (Visual Basic)
Perform Method, Step8 (Visual Basic)
Post Method, Step8 (Visual Basic)

Post Method, Step1 (Visual Basic)

Public Function Post(ByRef lngAccount As Long, _
    ByRef lngAmount As Long) As String
    On Error GoTo ErrorHandler
    Post = "Hello from Account!!!"
    Exit Function
' Return the error message indicating that 
' an error occurred.
ErrorHandler:
    Err.Raise Err.Number, "Bank.Account.Post", _
        Err.Description
End Function

Post Method, Step2 (Visual Basic)

Public Function Post(ByVal lngAccountNo As Long, _
    ByVal lngAmount As Long) As String
    Dim strResult As String
    On Error GoTo ErrorHandler
    ' obtain the ADO environment and connection
    Dim adoConn As New ADODB.Connection
    Dim varRows As Variant
    adoConn.Open strConnect
    On Error GoTo ErrorCreateTable
    ' update the balance
    Dim strSQL As String
    strSQL = "UPDATE Account SET Balance = Balance + "_
        + Str$(lngAmount) + " WHERE AccountNo = "
        + Str$(lngAccountNo)
TryAgain:
    adoConn.Execute strSQL, varRows
    ' if anything else happens
    On Error GoTo ErrorHandler
    ' get resulting balance which may have been 
    ' further updated via triggers
    strSQL = "SELECT Balance FROM Account " _
        + "WHERE AccountNo = " + Str$(lngAccountNo)
    Dim adoRS As ADODB.Recordset
    Set adoRS = adoConn.Execute(strSQL)
    If adoRS.EOF Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) + " not on file."
    End If
    Dim lngBalance As Long
    lngBalance = adoRS.Fields("Balance").Value
    ' check if account is overdrawn
    If (lngBalance) < 0 Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) _
            + " would be overdrawn by " _
            + Str$(lngBalance) + ". Balance is still "
            + Str$(lngBalance - lngAmount) + "."
    Else
        If lngAmount < 0 Then
            strResult = strResult _
                & "Debit from account "
                & lngAccountNo & ", "
        Else
            strResult = strResult _
                & "Credit to account " 
                & lngAccountNo & ", "
        End If
        strResult = strResult + "balance is $" 
            & Str$(lngBalance) & ". (VB)"
    End If
    ' cleanup
    Set adoRS = Nothing
    Set adoConn = Nothing
    Post = strResult
Exit Function
ErrorCreateTable:
    On Error GoTo ErrorHandler
    ' create the account table
    Dim objCreateTable As CreateTable
    Set objCreateTable = _
    GetObjectContext.CreateInstance("Bank.CreateTable")
    objCreateTable.CreateAccount
    GoTo TryAgain
ErrorHandler:
    ' cleanup
    If Not adoRS Is Nothing Then
        Set adoRS = Nothing
    End If
    If Not adoConn Is Nothing Then
        Set adoConn = Nothing
    End If
    Post = ""         ' indicate that an error occurred
    Err.Raise Err.Number, "Bank.Accout.Post", _
        Err.Description
End Function

Post Method, Step3 (Visual Basic)

Public Function Post(ByVal lngAccountNo As Long, _
    ByVal lngAmount As Long) As String
    Dim strResult As String
    On Error GoTo ErrorHandler
    ' obtain the ADO environment and connection
    Dim adoConn As New ADODB.Connection
    Dim varRows As Variant
    adoConn.Open strConnect
    On Error GoTo ErrorCreateTable
    ' update the balance
    Dim strSQL As String
    strSQL = "UPDATE Account SET Balance = Balance + "_
        + Str$(lngAmount) + " WHERE AccountNo = "
        + Str$(lngAccountNo)
TryAgain:
    adoConn.Execute strSQL, varRows
    ' if anything else happens
    On Error GoTo ErrorHandler
    ' get resulting balance which may have been 
    ' further updated via triggers
    strSQL = "SELECT Balance FROM Account " _
        + "WHERE AccountNo = " + Str$(lngAccountNo)
    Dim adoRS As ADODB.Recordset
    Set adoRS = adoConn.Execute(strSQL)
    If adoRS.EOF Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) + " not on file."
    End If
    Dim lngBalance As Long
    lngBalance = adoRS.Fields("Balance").Value
    ' check if account is overdrawn
    If (lngBalance) < 0 Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) _
            + " would be overdrawn by " _
            + Str$(lngBalance) + ". Balance is still "
            + Str$(lngBalance - lngAmount) + "."
    Else
        If lngAmount < 0 Then
            strResult = strResult _
                & "Debit from account "
                & lngAccountNo & ", "
        Else
            strResult = strResult _
                & "Credit to account " 
                & lngAccountNo & ", "
        End If
        strResult = strResult + "balance is $" 
            & Str$(lngBalance) & ". (VB)"
    End If
    ' cleanup
    Set adoRS = Nothing
    Set adoConn = Nothing
    ' we are finished and happy
    GetObjectContext.SetComplete
    Post = strResult
Exit Function
ErrorCreateTable:
    On Error GoTo ErrorHandler
    ' create the account table
    Dim objCreateTable As CreateTable
    Set objCreateTable = _
    GetObjectContext.CreateInstance("Bank.CreateTable")
    objCreateTable.CreateAccount
    GoTo TryAgain
ErrorHandler:
    ' cleanup
    If Not adoRS Is Nothing Then
        Set adoRS = Nothing
    End If
    If Not adoConn Is Nothing Then
        Set adoConn = Nothing
    End If
    GetObjectContext.SetAbort          ' we are unhappy
    Post = ""         ' indicate that an error occurred
    Err.Raise Err.Number, "Bank.Accout.Post", _
        Err.Description
End Function

Perform Method, Step4 (Visual Basic)

Public Function Perform(ByVal lngPrimeAccount As Long,_
    ByVal lngSecondAccount As Long, ByVal lngAmount _
    As Long, ByVal lngTranType As Long) As String
    Dim strResult As String
    On Error GoTo ErrorHandler
    ' create the account object using our context
    Dim objAccount As Bank.Account
    Set objAccount = _
        GetObjectContext.CreateInstance("Bank.Account")
    If objAccount Is Nothing Then
        Err.Raise ERROR_NUMBER, _
        Description:="Could not create account object"
    End If
    ' call the post function based on the 
    ' transaction type
    Select Case lngTranType
        Case 1
            strResult = objAccount.Post(lngPrimeAccount, 0 - lngAmount)
            If strResult = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult
            End If
        Case 2
            strResult = objAccount.Post(lngPrimeAccount, lngAmount)
            If strResult = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult
            End If
        Case 3
            Dim strResult1 As String, strResult2 As String
            ' do the credit
            strResult1 = objAccount.Post(lngSecondAccount, lngAmount)
            If strResult1 = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult1
            Else
                ' then do the debit
                strResult2 = objAccount.Post(lngPrimeAccount, 0 - lngAmount)
                If strResult2 = "" Then
                ' debit failed
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult2
                Else
                    strResult = strResult1 + "  " + strResult2
                End If
            End If
        Case Else
            Err.Raise ERROR_NUMBER, _
                Description:="Invalid Transaction Type"
    End Select
    ' we are finished and happy
    GetObjectContext.SetComplete
    Perform = strResult
    Exit Function
ErrorHandler:
    GetObjectContext.SetAbort          ' we are unhappy
    Perform = ""       ' indicate that an error occured
    Err.Raise Err.Number, "Bank.MoveMoney.Perform", _
        Err.Description
End Function

GetNextReceipt Method, Step5 (Visual Basic)

Public Function GetNextReceipt() As Long
    On Error GoTo ErrorHandler
    ' If Shared property does not already exist
    ' it will be initialized
    Dim spmMgr As SharedPropertyGroupManager
    Set spmMgr = CreateObject("MTxSpm.SharedPropertyGroupManager.1")
    Dim spmGroup As SharedPropertyGroup
    Dim bResult As Boolean
    Set spmGroup = _
        spmMgr.CreatePropertyGroup("Receipt", _
        LockMethod, Process, bResult)
    Dim spmPropNextReceipt As SharedProperty
    Set spmPropNextReceipt = _
        spmGroup.CreateProperty("Next", bResult)
    ' Set the initial value of the Shared Property to
    ' 0 if the Shared Property didn't already exist.
    ' This is not entirely necessary but demonstrates 
    ' how to initialize a value.
    If bResult = False Then
        spmPropNextReceipt.Value = 0
    End If
    ' Get the next receipt number and update property
    spmPropNextReceipt.Value = spmPropNextReceipt.Value + 1
    ' we are finished and happy
    GetObjectContext.SetComplete
    GetNextReceipt = spmPropNextReceipt.Value
    Exit Function
ErrorHandler:
    GetObjectContext.SetAbort          ' we are unhappy
    ' indicate that an error occured
    GetNextReceipt = -1
    Err.Raise Err.Number, _
        "Bank.GetReceipt.GetNextReceipt", _
        Err.Description
End Function

Perform Method, Step5 (Visual Basic)

Public Function Perform(ByVal lngPrimeAccount As Long,_
    ByVal lngSecondAccount As Long, ByVal lngAmount _
    As Long, ByVal lngTranType As Long) As String
    Dim strResult As String
    On Error GoTo ErrorHandler
    ' create the account object using our context
    Dim objAccount As Bank.Account
    Set objAccount = _
        GetObjectContext.CreateInstance("Bank.Account")
    If objAccount Is Nothing Then
        Err.Raise ERROR_NUMBER, _
        Description:="Could not create account object"
    End If
    ' call the post function based on the 
    ' transaction type
    Select Case lngTranType
        Case 1
            strResult = objAccount.Post(lngPrimeAccount, 0 - lngAmount)
            If strResult = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult
            End If
        Case 2
            strResult = objAccount.Post(lngPrimeAccount, lngAmount)
            If strResult = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult
            End If
        Case 3
            Dim strResult1 As String, strResult2 As String
            ' do the credit
            strResult1 = objAccount.Post(lngSecondAccount, lngAmount)
            If strResult1 = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult1
            Else
                ' then do the debit
                strResult2 = objAccount.Post(lngPrimeAccount, 0 - lngAmount)
                If strResult2 = "" Then
                ' debit failed
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult2
                Else
                    strResult = strResult1 + "  " + strResult2
                End If
            End If
        Case Else
            Err.Raise ERROR_NUMBER, _
                Description:="Invalid Transaction Type"
    End Select
    ' Get Receipt Number for the transaction
    Dim objReceiptNo As Bank.GetReceipt
    Dim lngReceiptNo As Long
    Set objReceiptNo = GetObjectContext.CreateInstance("Bank.GetReceipt")
    lngReceiptNo = objReceiptNo.GetNextReceipt
    If lngReceiptNo > 0 Then
        strResult = strResult & "; Receipt No: " _
            & Str$(lngReceiptNo)
    End If
    ' we are finished and happy
    GetObjectContext.SetComplete
    Perform = strResult
    Exit Function
ErrorHandler:
    GetObjectContext.SetAbort          ' we are unhappy
    Perform = ""       ' indicate that an error occured
    Err.Raise Err.Number, "Bank.MoveMoney.Perform", _
        Err.Description
End Function

StatefulPerform Method, Step6 (Visual Basic)

Public PrimeAccount As Long
Public SecondAccount As Long
Public Function StatefulPerform(ByVal lngAmount _
    As Long, ByVal lngTranType As Long) As String
    StatefulPerform = Perform(PrimeAccount, _
        SecondAccount, lngAmount, lngTranType)
End Function

Update Method, Step7 (Visual Basic)

Public Function Update() As Long
    On Error GoTo ErrorHandler
    ' get result set and then update table 
    ' with new receipt number
    Dim adoConn As New ADODB.Connection
    Dim adoRsReceipt As ADODB.Recordset
    Dim lngNextReceipt As Long
    Dim strSQL As String
    strSQL = "Update Receipt set NextReceipt = NextReceipt + 100"
    adoConn.Open strConnect
    ' Assume that if there is an ado error then
    ' the receipt table does not exist
    On Error GoTo ErrorCreateTable
TryAgain:
    adoConn.Execute strSQL
    strSQL = "Select NextReceipt from Receipt"
    Set adoRsReceipt = adoConn.Execute(strSQL)
    lngNextReceipt = adoRsReceipt!NextReceipt
    Set adoConn = Nothing
    Set adoRsReceipt = Nothing
    ' we are finished and happy
    GetObjectContext.SetComplete
    Update = lngNextReceipt
    Exit Function
ErrorCreateTable:
    On Error GoTo ErrorHandler
    ' create the receipt table
    Dim objCreateTable As CreateTable
    Set objCreateTable = CreateObject("Bank.CreateTable")
    objCreateTable.CreateReceipt
    GoTo TryAgain
ErrorHandler:
    If Not adoConn Is Nothing Then
        Set adoConn = Nothing
    End If
    If Not adoRsReceipt Is Nothing Then
        Set adoRsReceipt = Nothing
    End If
    GetObjectContext.SetAbort      ' we are unhappy
    Update = -1        ' indicate that an error occured
    Err.Raise Err.Number, "Bank.UpdateReceipt.Update", Err.Description
End Function

GetNextReceipt Method, Step7 (Visual Basic)

Public Function GetNextReceipt() As Long
    On Error GoTo ErrorHandler
    ' If Shared property does not already exist
    ' it will be initialized
    Dim spmMgr As SharedPropertyGroupManager
    Set spmMgr = CreateObject("MTxSpm.SharedPropertyGroupManager.1")
    Dim spmGroup As SharedPropertyGroup
    Dim bResult As Boolean
    Set spmGroup = _
        spmMgr.CreatePropertyGroup("Receipt", _
        LockMethod, Process, bResult)
    Dim spmPropNextReceipt As SharedProperty
    Set spmPropNextReceipt = _
        spmGroup.CreateProperty("Next", bResult)
    ' Set the initial value of the Shared Property to
    ' 0 if the Shared Property didn't already exist.
    ' This is not entirely necessary but demonstrates 
    ' how to initialize a value.
    If bResult = False Then
        spmPropNextReceipt.Value = 0
    End If
    Dim spmPropMaxNum As SharedProperty
    Set spmPropMaxNum = spmGroup.CreateProperty("MaxNum", bResult)
    Dim objReceiptUpdate As Bank.UpdateReceipt
    If spmPropNextReceipt.Value >= spmPropMaxNum.Value Then
        Set objReceiptUpdate = GetObjectContext.CreateInstance("Bank.UpdateReceipt")
        spmPropNextReceipt.Value = objReceiptUpdate.Update
        spmPropMaxNum.Value = spmPropNextReceipt.Value + 100
    End If
    ' Get the next receipt number and update property
    spmPropNextReceipt.Value = spmPropNextReceipt.Value + 1
    ' we are finished and happy
    GetObjectContext.SetComplete
    GetNextReceipt = spmPropNextReceipt.Value
    Exit Function
ErrorHandler:
    GetObjectContext.SetAbort          ' we are unhappy
    ' indicate that an error occured
    GetNextReceipt = -1
    Err.Raise Err.Number, "Bank.GetReceipt.GetNextReceipt", Err.Description
End Function

Perform Method, Step8 (Visual Basic)

Public Function Perform(ByVal lngPrimeAccount As Long,_
    ByVal lngSecondAccount As Long, ByVal lngAmount _
    As Long, ByVal lngTranType As Long) As String
    Dim strResult As String
    On Error GoTo ErrorHandler
    ' check for security
    If (lngAmount > 500 Or lngAmount < -500) Then
        If Not GetObjectContext.IsCallerInRole("Managers") Then
            Err.Raise Number:=APP_ERROR, _
            Description:="Need 'Managers' role for amounts over $500"
        End If
    End If
    ' create the account object using our context
    Dim objAccount As Bank.Account
    Set objAccount = _
        GetObjectContext.CreateInstance("Bank.Account")
    If objAccount Is Nothing Then
        Err.Raise ERROR_NUMBER, _
        Description:="Could not create account object"
    End If
    ' call the post function based on the 
    ' transaction type
    Select Case lngTranType
        Case 1
            strResult = objAccount.Post(lngPrimeAccount, 0 - lngAmount)
            If strResult = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult
            End If
        Case 2
            strResult = objAccount.Post(lngPrimeAccount, lngAmount)
            If strResult = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult
            End If
        Case 3
            Dim strResult1 As String, strResult2 As String
            ' do the credit
            strResult1 = objAccount.Post(lngSecondAccount, lngAmount)
            If strResult1 = "" Then
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult1
            Else
                ' then do the debit
                strResult2 = objAccount.Post(lngPrimeAccount, 0 - lngAmount)
                If strResult2 = "" Then
                ' debit failed
                Err.Raise ERROR_NUMBER, _
                    Description:=strResult2
                Else
                    strResult = strResult1 + "  " + strResult2
                End If
            End If
        Case Else
            Err.Raise ERROR_NUMBER, _
                Description:="Invalid Transaction Type"
    End Select
    ' Get Receipt Number for the transaction
    Dim objReceiptNo As Bank.GetReceipt
    Dim lngReceiptNo As Long
    Set objReceiptNo = GetObjectContext.CreateInstance("Bank.GetReceipt")
    lngReceiptNo = objReceiptNo.GetNextReceipt
    If lngReceiptNo > 0 Then
        strResult = strResult & "; Receipt No: " _
            & Str$(lngReceiptNo)
    End If
    ' we are finished and happy
    GetObjectContext.SetComplete
    Perform = strResult
    Exit Function
ErrorHandler:
    GetObjectContext.SetAbort          ' we are unhappy
    Perform = ""       ' indicate that an error occured
    Err.Raise Err.Number, "Bank.MoveMoney.Perform", _
        Err.Description
End Function

Post Method, Step8 (Visual Basic)

Public Function Post(ByVal lngAccountNo As Long, _
    ByVal lngAmount As Long) As String
    Dim strResult As String
    On Error GoTo ErrorHandler
    ' check for security
    If (lngAmount > 500 Or lngAmount < -500) Then
        If Not GetObjectContext.IsCallerInRole("Managers") Then
            Err.Raise Number:=APP_ERROR, _
            Description:="Need 'Managers' role for amounts over $500"
        End If
    End If
    ' obtain the ADO environment and connection
    Dim adoConn As New ADODB.Connection
    Dim varRows As Variant
    adoConn.Open strConnect
    On Error GoTo ErrorCreateTable
    ' update the balance
    Dim strSQL As String
    strSQL = "UPDATE Account SET Balance = Balance + "_
        + Str$(lngAmount) + " WHERE AccountNo = "
        + Str$(lngAccountNo)
TryAgain:
    adoConn.Execute strSQL, varRows
    ' if anything else happens
    On Error GoTo ErrorHandler
    ' get resulting balance which may have been 
    ' further updated via triggers
    strSQL = "SELECT Balance FROM Account " _
        + "WHERE AccountNo = " + Str$(lngAccountNo)
    Dim adoRS As ADODB.Recordset
    Set adoRS = adoConn.Execute(strSQL)
    If adoRS.EOF Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) + " not on file."
    End If
    Dim lngBalance As Long
    lngBalance = adoRS.Fields("Balance").Value
    ' check if account is overdrawn
    If (lngBalance) < 0 Then
        Err.Raise Number:=APP_ERROR, _
            Description:="Error. Account " _
            + Str$(lngAccountNo) _
            + " would be overdrawn by " _
            + Str$(lngBalance) + ". Balance is still "
            + Str$(lngBalance - lngAmount) + "."
    Else
        If lngAmount < 0 Then
            strResult = strResult _
                & "Debit from account "
                & lngAccountNo & ", "
        Else
            strResult = strResult _
                & "Credit to account " 
                & lngAccountNo & ", "
        End If
        strResult = strResult + "balance is $" 
            & Str$(lngBalance) & ". (VB)"
    End If
    ' cleanup
    Set adoRS = Nothing
    Set adoConn = Nothing
    ' we are finished and happy
    GetObjectContext.SetComplete
    Post = strResult
Exit Function
ErrorCreateTable:
    On Error GoTo ErrorHandler
    ' create the account table
    Dim objCreateTable As CreateTable
    Set objCreateTable = _
    GetObjectContext.CreateInstance("Bank.CreateTable")
    objCreateTable.CreateAccount
    GoTo TryAgain
ErrorHandler:
    ' cleanup
    If Not adoRS Is Nothing Then
        Set adoRS = Nothing
    End If
    If Not adoConn Is Nothing Then
        Set adoConn = Nothing
    End If
    GetObjectContext.SetAbort          ' we are unhappy
    Post = ""         ' indicate that an error occurred
    Err.Raise Err.Number, "Bank.Accout.Post", _
        Err.Description
End Function