Option Explicit

' Public
Public ErrorNumber As Long
Public ErrorDescription As String

Private mobjDBA As clsDBA

Public mRS As adodb.Recordset

' The FormatStringFill() function is used from ASP to fill an HTML string with optional recordset values.
' This function accepts a recordset, a format string and up to 8 recordset column names.
' For example:
'   strString = objVWTransfers.Display.FormatStringFill(objDisplay, "Rule ~1~", "rmsgText")
'   The line above tells the function to return a string containing the literal "Rule" and the
'   value from the recordset with the column name "rmsgText".
' The function can also apply formatting to the string.
'   ~$1~ fills the string with the first argument formatted as currency.
'   ~%7~ fills the string with the seventh argument formatted as a percentage.
'   ~D3~ fills the string with the decrypted value of the third argument.
'   ~E2~ fills the string with the encrypted value of the second second argument.
'   ~ECplan~ fills the string with the encrypted value of the constant that follows, in this case the literal "plan"
' The function can also perform condtional tests and evaluations.
' For example:
'   strString = objVWTransfers.Display.FormatStringFill(objVWFundInvested, "Transfer Detail: Sum: ~@(^5^ * 2)~, Permitted: ~?3|^4^|CNo~, ?~ECAcct=~~1~+~2~, ~3~", "planID", "fnblPlanCompany", "trfnTransferPermitted", "fnblID", "TransferSelected")
'   The line above uses the "@" function to request an evaluation of the 5th parameter times 2.
'   This line also uses the "?" IIF function to evaluate the 3rd parameter, and if true, return the 4th parameter. If
'   false, the literal "No" is returned instead.
'   Note that the "@" evaluation and the "?" IIF functions require that the parameter positions are escaped
'   by the "^" character. Had we more time to write a full parser, we could have used the "~" in all cases.
'   Similiarly, the "?" IIF function uses the "|" to indicate the different parts of the expression,
'   ie, |test|true|false|. The false part is optional, and will default to the empty string.

Public Function FormatStringFill(ByRef varDataSet As Variant, ByVal strFormat As String, Optional vArg01 As Variant, Optional vArg02 As Variant, Optional vArg03 As Variant, Optional vArg04 As Variant, Optional vArg05 As Variant, Optional vArg06 As Variant, Optional vArg07 As Variant, Optional vArg08 As Variant) As String
    ' Note: Must pass in variants for Optional ByRef strings unless using literals only when calling ASP to VB
    On Error GoTo ErrorTag
    Dim saArg(FSF_ARGCOUNT) As String
    
    If (ValidRecordset(varDataSet) Or ValidCollectionset(varDataSet)) Then
        ' Retrieve all the optional arguments
        'TK 04/14 - changed varDataSet.Fields(vArg01) to Trim$(varDataSet.Fields(vArg01) & "")
        'to accept the Null value
        If (Not IsMissing(vArg01)) Then saArg(1) = varDataSet.Fields(vArg01) & ""
        If (Not IsMissing(vArg02)) Then saArg(2) = varDataSet.Fields(vArg02) & ""
        If (Not IsMissing(vArg03)) Then saArg(3) = varDataSet.Fields(vArg03) & ""
        If (Not IsMissing(vArg04)) Then saArg(4) = varDataSet.Fields(vArg04) & ""
        If (Not IsMissing(vArg05)) Then saArg(5) = varDataSet.Fields(vArg05) & ""
        If (Not IsMissing(vArg06)) Then saArg(6) = varDataSet.Fields(vArg06) & ""
        If (Not IsMissing(vArg07)) Then saArg(7) = varDataSet.Fields(vArg07) & ""
        If (Not IsMissing(vArg08)) Then saArg(8) = varDataSet.Fields(vArg08) & ""

        ' Create the formatted string
        FormatStringFill = BuildString(strFormat, saArg)
        SetErrorReturn (0)
        varDataSet.MoveNext
    Else
        SetErrorReturn (-1)
    End If
    Exit Function
    
ErrorTag:
    ' Resume even if there was an error. This will allow some data to be generated.
    SetErrorReturn (-1)
    Resume Next

End Function

Public Function FormatStringRetrieve(ByVal strMarker As String, ByVal strFormItemIndex As String, ByVal strValueIndex As String) As clsCollectionSet
    On Error GoTo ErrorTag
    Dim objContext As ObjectContext
    Dim mRequest As Request
    Dim objRetrieve As New clsCollectionSet
    Dim colFormResult As clsFormResult
    Dim lngMarkerLen As Long
    Dim lngItemNameLen As Long
    Dim strFormItem As Variant

    ' Get the IIS/ASP context
    Set objContext = GetObjectContext()
    Set mRequest = objContext("Request")
    
    ' Set up initial values
    lngMarkerLen = Len(strMarker)
    
    ' Look for any form items that begin with the marker string
    For Each strFormItem In mRequest.Form
    ' Note: Use the From "Get" method to send the data
        lngItemNameLen = Len(strFormItem)
        If (lngItemNameLen >= lngMarkerLen) Then
            ' Found on of the form elements designated by the marker string
            If (strMarker = Left(strFormItem, lngMarkerLen)) Then
                ' Get the name and values, store them as a collection
                Set colFormResult = New clsFormResult
                colFormResult.Fields(CStr(strFormItemIndex)) = Right(strFormItem, lngItemNameLen - lngMarkerLen)
                colFormResult.Fields(CStr(strValueIndex)) = mRequest.Form(strFormItem)
                
                ' Add this collection to the Collectionset
                objRetrieve.Add colFormResult
            End If
        End If
    Next
    
    ' Release the object context
    Set mRequest = Nothing
    
    ' Return the form Collectionset
    Set FormatStringRetrieve = objRetrieve
    Exit Function

ErrorTag:
    ' Set error return code for all members
    SetErrorReturn (-1)
    Err.Raise Err.Number, Err.Source, Err.Description
    Exit Function
End Function

Public Function FormatDollar(ByVal strDollar As String) As String
    ' This function exposes the general purpose conversion function
    FormatDollar = ConvertDollar(strDollar)
End Function

Public Function FormatDate(ByVal strDateTime As String) As String
    On Error Resume Next
    FormatDate = Format$(strDateTime, "m/d/yy")
End Function

Public Function FormatTime(ByVal strDateTime As String) As String
    On Error Resume Next
    FormatTime = Format$(strDateTime, "h:mm AM/PM")
End Function

Public Function LocationName(ByVal strLocation As String) As String
    ' Determine which server we are on
    ' Switch on the subnet name and host server environment
    Select Case GetSiteByServer(strLocation)
        Case SITE_SFG: LocationName = "sfg"
        Case SITE_TX:  LocationName = "tx"
        Case SITE_FL:  LocationName = "fl"
        Case SITE_TN:  LocationName = "tn"
        Case Else:     LocationName = "sfg"
    End Select
    
    SetErrorReturn (0)
    Exit Function
End Function

Public Function LocationSSLRequired(ByVal strLocation As String) As Boolean
    Dim strEnvironment As String
    
    ' Get the Application level variable set in global.asa
    strEnvironment = ApplicationVariableGet(CONFIG_ENV)
    
    ' Does this environment require SSL?
    Select Case strEnvironment
        Case CONFIG_TST: LocationSSLRequired = False
        Case CONFIG_DEV: LocationSSLRequired = False
        Case CONFIG_MOD: LocationSSLRequired = False
        Case CONFIG_PRD: LocationSSLRequired = False
        Case Else: LocationSSLRequired = False
    End Select

    SetErrorReturn (0)
    Exit Function
End Function

Public Function URLEncrypt(ByVal strInput As String) As String
    ' Encrypt using the current default key
    URLEncrypt = URLEncode(ViperEncrypt(strInput, GetLocalKey()))
    SetErrorReturn (0)
End Function

Public Function URLDecrypt(ByVal strInput As String) As String
    ' Decrypt using the current default key
    URLDecrypt = URLDecode(ViperDecrypt(strInput, GetLocalKey()))
    SetErrorReturn (0)
End Function

Public Function EnCrypt(ByVal strInput As String) As String
    ' Encrypt using the current default key
    EnCrypt = ViperEncrypt(strInput, GetLocalKey())
    SetErrorReturn (0)
End Function

Public Function DeCrypt(ByVal strInput As String) As String
    ' Decrypt using the current default key
    DeCrypt = ViperDecrypt(strInput, GetLocalKey())
    SetErrorReturn (0)
End Function

Public Function GetStates(Optional strSelectedStateCode As String = "") As Long
    'retrieve a recordset containing state code, state name and a flag column
    'indicating which one is the "selected" one (if any). clsDisplay will expose
    'the recordset.
    
    On Error Resume Next
        
    Set mRS = mobjDBA.AccountQuerySP("sp_StatesGet", strSelectedStateCode)
    SetErrorReturn mobjDBA.ErrorNumber, mobjDBA.ErrorDescription
    GetStates = ErrorNumber
    
End Function

Public Function GetEmployersTennessee(Optional strSelectedEmpCode As String = "") As Long
    'retrieve a recordset containing employer code, name and a flag column
    'indicating which one is the "selected" one (if any). clsDisplay will expose
    'the recordset.
    
    On Error Resume Next
        
    Set mRS = mobjDBA.AccountQuerySP("sp_EmployersTennesseeGet", strSelectedEmpCode)
    SetErrorReturn mobjDBA.ErrorNumber, mobjDBA.ErrorDescription
    GetEmployersTennessee = ErrorNumber
    
End Function

Public Function GetEmployerNameTennessee(strEmpCode As String) As String
    'return the name for the code
    
    On Error Resume Next
        
    Set mRS = mobjDBA.AccountQuerySP("sp_EmployersTennesseeGet", strEmpCode)
    SetErrorReturn mobjDBA.ErrorNumber, mobjDBA.ErrorDescription
    If ErrorNumber = 0 Then
        Do While Not mRS.EOF
            If mRS("emptCode") = strEmpCode Then
                GetEmployerNameTennessee = mRS("emptName")
                Exit Do
            End If
            mRS.MoveNext
        Loop
        mRS.Close
        Set mRS = Nothing
    End If
    
End Function

Public Function GetNamePrefixes(Optional strSelectedNamePrefixId As String = "") As Long
    'retrieve a recordset containing name pfx code, name and a flag column
    'indicating which one is the "selected" one (if any). clsDisplay will expose
    'the recordset.
    
    On Error Resume Next
        
    Set mRS = mobjDBA.AccountQuerySP("sp_NamePrefixesGet", strSelectedNamePrefixId)
    SetErrorReturn mobjDBA.ErrorNumber, mobjDBA.ErrorDescription
    GetNamePrefixes = ErrorNumber
    
End Function

Function GetServerStatusLastAccess() As String
    On Error Resume Next
    Dim rstTemp As Recordset
    Dim lngSeconds As Long
    
    ' Get the current date and time from the server
    Set rstTemp = mobjDBA.ExecSQLRS("select max(userLastAccessDate) as userLastAccessDate from tblUser")
    
    ' Return time in minutes if successfull
    If ValidRecordset(rstTemp) Then
        lngSeconds = DateDiff("s", CDate(rstTemp("userLastAccessDate")), CDate(GetServerDateTime()))
        GetServerStatusLastAccess = Format(CStr((lngSeconds / 60#) + 0.05), "###,##0.0")
    End If
    
    SetErrorReturn mobjDBA.ErrorNumber, mobjDBA.ErrorDescription
End Function

Function GetLastLoadStartDateTime() As String
    
    On Error Resume Next

    Dim rstTemp As Recordset
    
    'Get last load time
    Set rstTemp = mobjDBA.ExecSQLRS("Select Replace(Convert(VarChar, LastLoadStart, 100), '  ', ' ') As LastLoadStart From vw_LastLoad")
    
    'If able to get data
    If ValidRecordset(rstTemp) Then
        
        'Set return value to last load datetime
        GetLastLoadStartDateTime = FormatDate(rstTemp(0).Value) & " " & FormatTime(rstTemp(0).Value)
    
    Else
    
        'Unable to get last load date - Set value to 'Unknown'
        GetLastLoadStartDateTime = "Unknown"
        
    End If
End Function

Function GetLastLoadEndDateTime() As String
    
    On Error Resume Next

    Dim rstTemp As Recordset
    
    'Get last load time
    Set rstTemp = mobjDBA.ExecSQLRS("Select Replace(Convert(VarChar, LastLoadEnd, 100), '  ', ' ') As LastLoadEnd From vw_LastLoad")
    
    'If able to get data
    If ValidRecordset(rstTemp) Then
        
        'Set return value to last load datetime
        GetLastLoadEndDateTime = FormatDate(rstTemp(0).Value) & " " & FormatTime(rstTemp(0).Value)
    
    Else
    
        'Unable to get last load date - Set value to 'Unknown'
        GetLastLoadEndDateTime = "Unknown"
        
    End If
End Function

Function GetServerDateTime() As String
    Dim rstTemp As Recordset
    
    ' Get the current date and time from the server
    Set rstTemp = mobjDBA.ExecSQLRS("select GetDate() as CurrentDate")
    
    ' Return if success
    If ValidRecordset(rstTemp) Then
        GetServerDateTime = rstTemp("CurrentDate")
    End If
    
    SetErrorReturn mobjDBA.ErrorNumber, mobjDBA.ErrorDescription

End Function

Function GetServerNumber() As String
    On Error Resume Next
    GetServerNumber = Val(Right(ComputerNameGet(), 1))
End Function

Friend Sub SetErrorReturn(ByVal lngErrorNumber As Long, Optional ByVal strErrorDescription As String)

    ' Set error return code for all members
    ErrorNumber = lngErrorNumber
    ErrorDescription = IIf(IsMissing(strErrorDescription), "", strErrorDescription)
    
End Sub

Private Sub Class_Initialize()
    Set mobjDBA = New clsDBA
    Set mRS = Nothing
End Sub

Private Sub Class_Terminate()
    Set mobjDBA = Nothing
    
    If Not mRS Is Nothing Then
        If mRS.State = adStateOpen Then mRS.Close
        Set mRS = Nothing
    End If
End Sub