home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 February / CHIP_2_98.iso / software / pelne / optionp / mts4.cab / Account.VB_account.cls next >
Text File  |  1997-11-14  |  4KB  |  121 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Account"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. ' Filename: Account.vbp
  11. '
  12. ' Description:  Account Class
  13. '
  14. ' This file is provided as part of the Microsoft Transaction Server Samples
  15. '
  16. ' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT
  17. ' WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
  18. ' INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
  19. ' OF MERCHANTABILITY AND/OR FITNESS FOR A  PARTICULAR
  20. ' PURPOSE.
  21. '
  22. ' Copyright (C) 1997 Microsoft Corporation, All rights reserved
  23.  
  24. Option Explicit
  25.  
  26. Private Const ERROR_NUMBER = vbObjectError + 0
  27. Private Const APP_ERROR = -2147467008
  28. Private Const strConnect = "FILEDSN=MTSSamples"
  29.  
  30. Public Function Post(ByVal lngAccountNo As Long, ByVal lngAmount As Long) As String
  31.     
  32.     Dim strResult As String
  33.     
  34.     On Error GoTo ErrorHandler
  35.     
  36.     ' check for security
  37.     If (lngAmount > 500 Or lngAmount < -500) Then
  38.         If Not GetObjectContext.IsCallerInRole("Managers") Then
  39.             Err.Raise Number:=APP_ERROR, Description:="Need 'Managers' role for amounts over $500"
  40.         End If
  41.     End If
  42.     
  43.     ' obtain the ADO environment and connection
  44.     Dim adoConn As New ADODB.Connection
  45.     Dim varRows As Variant
  46.     
  47.     adoConn.Open strConnect
  48.    
  49.     On Error GoTo ErrorCreateTable
  50.  
  51.     ' update the balance
  52.     Dim strSQL As String
  53.     strSQL = "UPDATE Account SET Balance = Balance + " + Str$(lngAmount) + " WHERE AccountNo = " + Str$(lngAccountNo)
  54.     
  55. TryAgain:
  56.     adoConn.Execute strSQL, varRows
  57.  
  58.     ' if anything else happens
  59.     On Error GoTo ErrorHandler
  60.   
  61.     ' get resulting balance which may have been further updated via triggers
  62.     strSQL = "SELECT Balance FROM Account WHERE AccountNo = " + Str$(lngAccountNo)
  63.     
  64.     Dim adoRS As ADODB.Recordset
  65.     Set adoRS = adoConn.Execute(strSQL)
  66.     If adoRS.EOF Then
  67.         Err.Raise Number:=APP_ERROR, Description:="Error. Account " + Str$(lngAccountNo) + " not on file."
  68.     End If
  69.  
  70.     Dim lngBalance As Long
  71.     lngBalance = adoRS.Fields("Balance").Value
  72.     
  73.     ' check if account is overdrawn
  74.     If (lngBalance) < 0 Then
  75.         Err.Raise Number:=APP_ERROR, Description:="Error. Account " + Str$(lngAccountNo) + " would be overdrawn by " + Str$(lngBalance) + ". Balance is still " + Str$(lngBalance - lngAmount) + "."
  76.     Else
  77.         If lngAmount < 0 Then
  78.             strResult = strResult & "Debit from account " & lngAccountNo & ", "
  79.         Else
  80.             strResult = strResult & "Credit to account " & lngAccountNo & ", "
  81.         End If
  82.         strResult = strResult + "balance is $" & Str$(lngBalance) & ". (VB)"
  83.     End If
  84.  
  85.     ' cleanup
  86.     Set adoRS = Nothing
  87.     Set adoConn = Nothing
  88.     
  89.     GetObjectContext.SetComplete          ' we are finished and happy
  90.     
  91.     Post = strResult
  92.     
  93.  Exit Function
  94.  
  95. ErrorCreateTable:
  96.     On Error GoTo ErrorHandler
  97.     
  98.     ' create the account table
  99.     Dim objCreateTable As CreateTable
  100.     Set objCreateTable = GetObjectContext.CreateInstance("Bank.CreateTable")
  101.     objCreateTable.CreateAccount
  102.       
  103.     GoTo TryAgain
  104.  
  105. ErrorHandler:
  106.     ' cleanup
  107.     If Not adoRS Is Nothing Then
  108.         Set adoRS = Nothing
  109.     End If
  110.     If Not adoConn Is Nothing Then
  111.         Set adoConn = Nothing
  112.     End If
  113.     
  114.     GetObjectContext.SetAbort              ' we are unhappy
  115.     
  116.     Post = ""                       ' indicate that an error occurred
  117.     
  118.     Err.Raise Err.Number, "Bank.Accout.Post", Err.Description
  119.     
  120. End Function
  121.