VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Broker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Const m_modName = "FMStocks_Bus.Broker"
Const m_errInsufficentFunds As Long = &H80040E14
Const m_Commission As Currency = 9.95


' returns 0 on nothing to do, -1 on error, otherwise the TxID
Public Function BuyStock(ByVal AccountID As Long, _
        ByVal Ticker As String, _
        ByVal Shares As Long) As Long
        
    On Error GoTo errorHandler
    
    Dim lngErr As Long
    Dim lngTXID As Long
    Dim lngPositionID As Long
    Dim lngPrice As Long
    
    Dim objTX As FMStocks_DB.Tx
    Dim objTicker As FMStocks_DB.Ticker
    Dim objbroker As FMStocks_DB.Broker
    Dim objTXNew As FMStocks_DB.TxNew
    
    Set objTX = New FMStocks_DB.Tx
    Set objTicker = New FMStocks_DB.Ticker
    Set objbroker = New FMStocks_DB.Broker
    
    ' first log the transaction
    lngTXID = objTX.AddBuyOrder(AccountID, Ticker, Shares)
    
    
    'Get the current price
    lngPrice = objTicker.GetPrice(Ticker)      ' price in pennies

    On Error Resume Next
    lngPositionID = objbroker.Buy(lngTXID, AccountID, Ticker, Shares, lngPrice, m_Commission)
    lngErr = Err.Number       ' the next line resets Err.Number to 0, so we need to cache it
    On Error GoTo errorHandler
    
    If lngPositionID = 0 And lngErr = m_errInsufficentFunds Then
        ' It's common that the user doesn't have enough funds.
        ' Set the TransactionTypeID = 5 indicating insufficient funds
        
        ' This guy runs as a separate transaction
        Set objTXNew = New FMStocks_DB.TxNew
        objTXNew.SetTxType lngTXID, FMStocks_TransactionType.Insufficient_Funds
        
        GoTo InsufficientFundsHandler
    ElseIf lngPositionID = 0 Then
        GoTo errorHandler       ' some other error was thrown that we can't handle
    Else
        BuyStock = lngTXID     ' The trade was handled
    End If
    
    Set objTX = Nothing
    Set objbroker = Nothing
    Set objTXNew = Nothing
    Set objTicker = Nothing

    
    Exit Function
    
InsufficientFundsHandler:
    BuyStock = 0        ' Signify that we handled this error.
                        ' The caller should be aware that when this is returned,
                        ' the transaction has been aborted, the object deactivated.
                        ' An error isn't raised here (SP2) to be consistent with
                        ' prior versions.
                        
    Set objTX = Nothing
    Set objTicker = Nothing
    Set objbroker = Nothing
    Set objTXNew = Nothing

    
    Exit Function
    
errorHandler:
    BuyStock = -1
    Set objTX = Nothing
    Set objTicker = Nothing
    Set objbroker = Nothing
    Set objTXNew = Nothing

    
    RaiseError m_modName, "BuyStock(" & AccountID & "," & Ticker & "," & Shares & ")"
    
End Function

' returns 0 on nothing to do, -1 on error, otherwise the TxID
Public Function SellStock(ByVal AccountID As Long, _
        ByVal Ticker As String, _
        ByVal Shares As Long) As Long
        
    On Error GoTo errorHandler
    
    Dim price As Currency
    Dim txid As Long
    Dim bSellretval As Boolean
    
    Dim objTX As FMStocks_DB.Tx
    Dim objbroker As FMStocks_DB.Broker
    Dim objTXNew As FMStocks_DB.TxNew
    Dim objTicker As FMStocks_DB.Ticker
    
    Set objTX = New FMStocks_DB.Tx
    Set objbroker = New FMStocks_DB.Broker
    Set objTicker = New FMStocks_DB.Ticker
    
    txid = objTX.AddSellOrder(AccountID, Ticker, Shares)
    Set objTX = Nothing
    
    'Get the current price
    price = objTicker.GetPrice(Ticker)      ' price in pennies
    
    On Error Resume Next
    'ignore errors on this.
    bSellretval = objbroker.Sell(txid, price, m_Commission)
    
    On Error GoTo errorHandler
    
    If bSellretval <> True Then
        ' This runs as a separate transaction
        Set objTXNew = New FMStocks_DB.TxNew
        
        ' User tried to sell shares they didn't own
        objTXNew.SetTxType txid, FMStocks_TransactionType.Not_Enough_Shares
        
        GoTo NotEnoughSharesHandler
    Else
        ' We're responsible for removing the appropriate shares from their positions
        AdjustPositions AccountID, Ticker, Shares
        SellStock = txid
    End If

    Set objTX = Nothing
    Set objbroker = Nothing
    Set objTXNew = Nothing
    Set objTicker = Nothing
    
    
    Exit Function

NotEnoughSharesHandler:
    SellStock = 0       ' Signify that we handled this error.
                        ' The caller should be aware that when this is returned,
                        ' the transaction has been aborted, the object deactivated.
                        ' An error isn't raised here (SP2) to be consistent with
                        ' prior versions.

    Set objTX = Nothing
    Set objbroker = Nothing
    Set objTXNew = Nothing
    Set objTicker = Nothing

    
    Exit Function
    
errorHandler:
    SellStock = -1
    Set objTX = Nothing
    Set objbroker = Nothing
    Set objTXNew = Nothing
    Set objTicker = Nothing
    
    
    RaiseError m_modName, "SellStock(" & AccountID _
                          & "," & Ticker & "," & Shares & ")"
End Function

' no longer in used by buy or sell stocks
' Used by ExecuteTrade program.
' Returns 0 on nothing to do, -1 on error, otherwise the TxID
Public Function ExecuteTransaction(ByVal txid As Long) As Long
    On Error GoTo errorHandler
    
    Dim rs As Recordset
    Dim objTX As FMStocks_DB.Tx
    Dim objTicker As FMStocks_DB.Ticker
    Dim objbroker As FMStocks_DB.Broker
    Dim o As FMStocks_DB.TxNew
    
    Set objTX = New FMStocks_DB.Tx
    Set objTicker = New FMStocks_DB.Ticker
    Set objbroker = New FMStocks_DB.Broker
    
    'information about the current transaction
    Dim AccountID As Long
    Dim Ticker As String
    Dim PositionID As Long
    Dim price As Currency
    Dim retval As Boolean
    
    Dim lerr As Long
    
    
    ' Get the Tx details
    Set rs = objTX.GetByID(txid)
    
    If (rs.EOF And rs.BOF) Then Exit Function
    
    AccountID = rs("AccountID")
    Ticker = RTrim(rs("Ticker").Value)
    
    ' Only execute buy or sell orders
    If rs("TransactionTypeID") <> 1 And rs("TransactionTypeID") <> 2 Then
        ExecuteTransaction = 0
        
        Exit Function
    End If
    
    'Get the current price
    price = objTicker.GetPrice(Ticker)      ' price in pennies
    
    'Execute the trade
    If rs("TransactionTypeID") = 1 Then
        ' Buy order
    
        On Error Resume Next
        PositionID = objbroker.Buy(txid, AccountID, Ticker, rs("shares"), price, m_Commission)
        lerr = Err.Number       ' the next line resets Err.Number to 0, so we need to cache it
        On Error GoTo errorHandler
        
        If PositionID = 0 And lerr = m_errInsufficentFunds Then
            ' It's common that the user doesn't have enough funds.
            ' Set the TransactionTypeID = 5 indicating insufficient funds
            
            ' This guy runs as a separate transaction
            Set o = New FMStocks_DB.TxNew
            o.SetTxType txid, FMStocks_TransactionType.Insufficient_Funds
            Set o = Nothing
            
            GoTo InsufficientFundsHandler
        ElseIf PositionID = 0 Then
            GoTo errorHandler       ' some other error was thrown that we can't handle
        Else
            ExecuteTransaction = txid     ' The trade was handled
        End If
    Else
        ' Sell order
        
        On Error Resume Next
        retval = objbroker.Sell(txid, price, m_Commission)
        lerr = Err.Number       ' the next line resets Err.Number to 0, so we need to cache it
        On Error GoTo errorHandler
        
        If retval = False Then
            Err.Clear
            
            ' This runs as a separate transaction
            Set o = New FMStocks_DB.TxNew
            o.SetTxType txid, FMStocks_TransactionType.Not_Enough_Shares  ' User tried to sell shares they didn't own
            Set o = Nothing
            
            GoTo NotEnoughSharesHandler
        Else
            ' We're responsible for removing the appropriate shares from their positions
            AdjustPositions AccountID, Ticker, rs("shares")
            ExecuteTransaction = txid
        End If
        
    End If

    
    Exit Function
    
InsufficientFundsHandler:
NotEnoughSharesHandler:
    ExecuteTransaction = 0     ' Signify that we handled this error.
                               ' The caller should be aware that when this is returned,
                               ' the transaction has been aborted, the object deactivated.
                               ' An error isn't raised here (SP2) to be consistent with
                               ' prior versions.

    Set objTX = Nothing
    Set objTicker = Nothing
    Set objbroker = Nothing
    Set rs = Nothing
    
    
    Exit Function
    
errorHandler:
    ExecuteTransaction = -1 'an invalid TransactionID used to flag an error.
    Set objTX = Nothing
    Set objTicker = Nothing
    Set objbroker = Nothing
    Set rs = Nothing
    Set o = Nothing
    
    
    RaiseError m_modName, "ExecuteTransaction(" & txid & ")"
    
End Function

'all errors are handled by the caller, ExecuteTransaction
Private Sub AdjustPositions(ByVal AccountID As Long, ByVal Ticker As String, ByVal Shares As Long)
    Dim objPosition As FMStocks_DB.Position
    Set objPosition = New FMStocks_DB.Position
    
    Dim rs As ADODB.Recordset
    Dim posShares As Long ' number of shares for the current position
    Dim origShares As Long 'number of shares before sell
    Dim boolAdjusted As Boolean
    
    boolAdjusted = False
    
    Set rs = objPosition.ListForAdjustment(AccountID, Ticker)
    Do While (Not (rs.EOF) And Shares > 0)
        posShares = rs("shares")
        boolAdjusted = True
        If posShares <= Shares Then
            ' we can delete this whole record
            rs.Delete
            Shares = Shares - posShares
        Else
            rs("shares").Value = posShares - Shares     ' decrement current share amount by amount sold
            Shares = 0
        End If
        rs.MoveNext
    Loop
    rs.UpdateBatch
    rs.Close
    Set rs = Nothing
End Sub
