VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Member"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Function AddNew(ByVal strFileDSN As String, ByVal strFirstName As String, ByVal strLastName As String, ByVal strMiddleName As String, ByVal strKnownAs As String, _
     ByVal strGender As String, ByVal strAddress1 As String, ByVal strAddress2 As String, ByVal strCity As String, ByVal strState As String, ByVal strPostCode As String, _
     ByVal strCountry As String, ByVal strHomePhone As String, ByVal strBusinessPhone As String, ByVal strFax As String, ByVal strEmail As String, _
     ByVal strWebSite As String, ByVal strMeal As String, ByVal strSeating As String, _
     ByVal strExitRow As String, ByVal lngMileage As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim lngAccountID As Long
    Dim cnn As New ADODB.Connection
    Dim arrReturn(2)
    Dim strPassword As String
    
    arrReturn(0) = 0
    strPassword = InventPassword()
    
    'TakeANumber generates a unique account number and insures that no one will
    'concurrently choose the same number
    
    ' This method is in another class, so have to "objContext.CreateInstance"
    '   Note that should not CreateObject in this circumstance, because if
    '   CreateObject, will get a NEW transaction that cannot see the work
    '   done in this (calling) transaction
    Dim TakeANum As Object
    Set TakeANum = objContext.CreateInstance("MTS_TakeANumber.TakeANumber")
    lngAccountID = TakeANum.GetANumber(strFileDSN, "AccountID")
        
    strSQL = "INSERT INTO Member " & _
                          "(Password, " & _
                          "AccountID, " & _
                          "FirstName, " & _
                          "LastName, " & _
                          "MiddleName, " & _
                          "KnownAs, " & _
                          "Gender, " & _
                          "Address1, " & _
                          "Address2, " & _
                          "City, " & _
                          "State, " & _
                          "PostCode, " & _
                          "Country, " & _
                          "HomePhone, " & _
                          "BusinessPhone, " & _
                          "Fax, " & _
                          "Email, " & _
                          "Mileage, " & _
                          "WebSite, " & _
                          "Meal, " & _
                          "Seating, " & _
                          "ExitRow)"
        
    strSQL = strSQL & _
                        "VALUES ('" & _
                                SQLEncode(strPassword) & "', " & _
                                lngAccountID & ", '" & _
                                SQLEncode(strFirstName) & "', '" & _
                                SQLEncode(strLastName) & "', '" & _
                                SQLEncode(strMiddleName) & "', '" & _
                                SQLEncode(strKnownAs) & "', '" & _
                                SQLEncode(strGender) & "', '" & _
                                SQLEncode(strAddress1) & "', '" & _
                                SQLEncode(strAddress2) & "', '" & _
                                SQLEncode(strCity) & "', '" & _
                                SQLEncode(strState) & "', '" & _
                                SQLEncode(strPostCode) & "', '" & _
                                SQLEncode(strCountry) & "', '" & _
                                SQLEncode(strHomePhone) & "', '" & _
                                SQLEncode(strBusinessPhone) & "', '" & _
                                SQLEncode(strFax) & "', '" & _
                                SQLEncode(strEmail) & "', " & _
                                lngMileage & ", '" & _
                                SQLEncode(strWebSite) & "', '" & _
                                SQLEncode(strMeal) & "', '" & _
                                SQLEncode(strSeating) & "', '" & _
                                SQLEncode(strExitRow) & "')"
                                
    cnn.Open "FileDSN=" & strFileDSN
    cnn.Execute (strSQL)
    
    objContext.SetComplete
    AddNew = lngAccountID
    Exit Function
    
ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "Member.AddNew()", Err.Description

End Function

Function Update(ByVal strFileDSN As String, ByVal lngAccountID As Long, ByVal strFirstName As String, ByVal strLastName As String, ByVal strMiddleName As String, ByVal strKnownAs As String, _
     ByVal strGender As String, ByVal strAddress1 As String, ByVal strAddress2 As String, ByVal strCity As String, ByVal strState As String, ByVal strPostCode As String, _
     ByVal strCountry As String, ByVal strHomePhone As String, ByVal strBusinessPhone As String, ByVal strFax As String, ByVal strEmail As String, _
     ByVal strWebSite As String, ByVal strMeal As String, ByVal strSeating As String, _
     ByVal strExitRow As String)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim cnn As New ADODB.Connection
    strSQL = "UPDATE Member " & _
        "SET FirstName = '" & SQLEncode(strFirstName) & "'," & _
            "LastName = '" & SQLEncode(strLastName) & "'," & _
            "MiddleName = '" & SQLEncode(strMiddleName) & "'," & _
            "KnownAs = '" & SQLEncode(strKnownAs) & "'," & _
            "Gender = '" & SQLEncode(strGender) & "'," & _
            "Address1 = '" & SQLEncode(strAddress1) & "'," & _
            "Address2 = '" & SQLEncode(strAddress2) & "'," & _
            "City = '" & SQLEncode(strCity) & "'," & _
            "State = '" & SQLEncode(strState) & "'," & _
            "PostCode = '" & SQLEncode(strPostCode) & "'," & _
            "Country = '" & SQLEncode(strCountry) & "'," & _
            "HomePhone = '" & SQLEncode(strHomePhone) & "'," & _
            "BusinessPhone = '" & SQLEncode(strBusinessPhone) & "'," & _
            "Fax = '" & SQLEncode(strFax) & "'," & _
            "Email = '" & SQLEncode(strEmail) & "'," & _
            "WebSite = '" & SQLEncode(strWebSite) & "'," & _
            "Meal = '" & SQLEncode(strMeal) & "'," & _
            "Seating = '" & SQLEncode(strSeating) & "'," & _
            "ExitRow = '" & SQLEncode(strExitRow) & "'" & _
        "WHERE AccountID = " & lngAccountID
        
    cnn.Open "FILEDSN=" & strFileDSN
    cnn.Execute strSQL
    
    objContext.SetComplete
    
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "Member.Update()", Err.Description
    
End Function

Function ChangePassword(ByVal strFileDSN As String, ByVal lngAccountID As Long, _
     ByVal strPassword As String)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim cnn As New ADODB.Connection
    strSQL = "UPDATE Member " & _
        "SET Password = '" & SQLEncode(strPassword) & "' " & _
        "WHERE AccountID = " & lngAccountID
        
    cnn.Open "FILEDSN=" & strFileDSN
    cnn.Execute strSQL
    
    objContext.SetComplete
    
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "Member.ChangePassword()", Err.Description
    
End Function

Function Remove(ByVal strFileDSN As String, ByVal lngAccountID As Long)
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim cnn As New ADODB.Connection
    
    strSQL = "DELETE FROM Member WHERE AccountID = " & lngAccountID
    cnn.Open "FILEDSN=" & strFileDSN
    cnn.Execute strSQL
    
    objContext.SetComplete
    
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "Member.Remove()", Err.Description

End Function

Function UpdateInterests(ByVal strFileDSN As String, ByVal lngAccountID As Long, Interests)
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim cnn As New ADODB.Connection, varItem As Variant

    strSQL = "DELETE FROM MembersInterests WHERE AccountID = " & lngAccountID
    
    cnn.Open "FILEDSN=" & strFileDSN
    cnn.Execute strSQL
    For Each varItem In Interests
        strSQL = "INSERT INTO MembersInterests (AccountID, InterestID) " & _
                "VALUES (" & lngAccountID & "," & varItem & ")"
        cnn.Execute strSQL
    Next
    
    objContext.SetComplete
    UpdateInterests = 0
           
    Exit Function
    
ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "Member.UpdateInterests()", Err.Description
    
End Function

Private Function SQLEncode(str As String) As String
    
    Dim vntPosition As Variant
    
    If IsNull(str) Or str = "" Then

    Else
        vntPosition = InStr(str, "'")
        Do While vntPosition <> 0
            str = Mid(str, 1, vntPosition - 1) & "`'`" & Mid(str, vntPosition + 1)
            vntPosition = InStr(vntPosition + 2, str, "'")
        Loop
    End If
    SQLEncode = str
    
End Function

Private Function InventPassword() As String
    
    Dim strPass As String, x
    Randomize
    
    For x = 1 To 5
        strPass = strPass & Chr(Int((25 * Rnd) + 65))
    Next
        
    InventPassword = strPass
    
End Function

Function GetForID(ByVal strFileDSN As String, ByVal lngAccountID As Long) As Variant
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
    
    strSQL = "SELECT FirstName," & _
                "LastName," & _
                "MiddleName," & _
                "KnownAs," & _
                "Password," & _
                "Gender," & _
                "Address1," & _
                "Address2," & _
                "City," & _
                "State," & _
                "PostCode," & _
                "Country," & _
                "HomePhone," & _
                "BusinessPhone," & _
                "Fax," & _
                "Email," & _
                "WebSite," & _
                "Mileage," & _
                "Seating," & _
                "Smoking," & _
                "Bulkhead," & _
                "ExitRow," & _
                "Meal," & _
                "Comment " & _
            "FROM Member WHERE AccountID = " & lngAccountID
    
    rst.CursorLocation = adUseServer
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
    
    objContext.SetComplete
    Set GetForID = rst
    Exit Function
    
ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "Member.GetForID()", Err.Description
    
End Function

Function ListForName(ByVal strFileDSN As String, ByVal strLastName As String)
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
    
    strSQL = "SELECT FirstName," & _
                "LastName," & _
                "MiddleName," & _
                "KnownAs," & _
                "Gender," & _
                "Address1," & _
                "Address2," & _
                "City," & _
                "State," & _
                "PostCode," & _
                "Country," & _
                "HomePhone," & _
                "BusinessPhone," & _
                "Fax," & _
                "Email," & _
                "WebSite," & _
                "Mileage," & _
                "Comment " & _
            "FROM Member WHERE LastName = '" & strLastName & "'"
    
    rst.CursorLocation = adUseServer
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
    
    objContext.SetComplete
    Set ListForName = rst
    
    Exit Function
    
ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing
    
    objContext.SetAbort
    Err.Raise Err.Number, "Member.ListForName()", Err.Description
    
End Function

Function CheckPassword(ByVal strFileDSN As String, ByVal lngAccountID As Long, ByVal strPassword As String)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
   
    strSQL = "SELECT Password FROM Member WHERE AccountID = " & lngAccountID
    
    rst.CursorLocation = adUseServer
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenForwardOnly, adLockReadOnly
    
    'check to see if an account exists for that ID, if so then check password
    If rst.EOF Then
        CheckPassword = 0
    ElseIf rst("Password") = strPassword Then
        CheckPassword = 1
    Else
        CheckPassword = 0
    End If
     
    objContext.SetComplete
     
    Exit Function
    
ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing
    
    objContext.SetAbort
    Err.Raise Err.Number, "Member.CheckPassword()", Err.Description
    
End Function


Function ListInterests(ByVal strFileDSN As String, ByVal lngAccountID As Long)
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
    
    strSQL = "SELECT Interests.InterestID, " & _
                    "Interests.InterestDescription, " & _
                    "MembersInterests.AccountID, " & _
                    "InterestCategories.Description " & _
             "FROM (Interests INNER JOIN InterestCategories " & _
                        "ON Interests.CategoryID = InterestCategories.CategoryID) " & _
                    "LEFT JOIN MembersInterests " & _
                        "ON Interests.InterestID = MembersInterests.InterestID " & _
                        "AND MembersInterests.AccountID =  " & lngAccountID & _
             "ORDER BY InterestCategories.SortOrder,  " & _
                       "Interests.InterestDescription"
                
    rst.CursorLocation = adUseServer
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
    
    objContext.SetComplete
    Set ListInterests = rst
    
    Exit Function
    
ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing
    
    objContext.SetAbort
    Err.Raise Err.Number, "Member.ListInterests()", Err.Description

End Function
    
Function GetMileage(ByVal strFileDSN As String, ByVal lngAccountID As Long)
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
    
    strSQL = "SELECT Mileage FROM Member WHERE AccountID = " & lngAccountID
    
    rst.CursorLocation = adUseServer
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
    
    objContext.SetComplete
    GetMileage = rst("Mileage")
    
    Exit Function
    
ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing
    
    objContext.SetAbort
    Err.Raise Err.Number, "Member.GetMileage()", Err.Description
    
End Function

Function GetPassword(ByVal strFileDSN As String, ByVal lngAccountID As Long)
    
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext
    
    On Error GoTo ErrorHandler
    
    Dim strSQL As String
    Dim rst As New ADODB.Recordset
    
    strSQL = "SELECT Password FROM Member WHERE AccountID = " & lngAccountID
    
    rst.CursorLocation = adUseServer
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
    
    objContext.SetComplete
    GetPassword = rst("Password")
    
    Exit Function
    
ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing
    
    objContext.SetAbort
    Err.Raise Err.Number, "Member.GetPassword()", Err.Description
    
End Function
