'*******************************************************************************
' Project   : Generic
'
' Module    : basEncryptDecrypt
' DateTime  : 3/26/2010 09:01
' Author    : Arvin Meyer
' Purpose   : Various encryption procedures
' References:
' Index     :(Updated on 3/26/2010)
  ' Encrypt - Encrypt/Decrypt string using key
'*******************************************************************************

Option Compare Database
Option Explicit

Public Function Encrypt(ByVal strIn As String, ByVal strKey As String) As String
'Purpose  : Encrypt/Decrypt string using key
'DateTime : 12/27/2007
'Author   : Arvin Meyer
'Requires : strIn - Value to be encrypted or decrypted
'           strKey - Case sensitive password key
    Dim i As Integer
    Dim bytData As Byte
    Dim bytKey As Byte
    Dim strEncrypted As String

    On Error GoTo err_PROC

    Encrypt = vbNullString

    For i = 1 To Len(strIn)
        bytData = Asc(Mid(strIn, i, 1))
        bytKey = Asc(Mid(strKey, (i Mod Len(strKey)) + 1))
        strEncrypted = strEncrypted & Chr(bytData Xor bytKey)
    Next i

    If strEncrypted <> vbNullString Then
        Encrypt = strEncrypted
    End If


exit_PROC:
    On Error Resume Next
    Exit Function

err_PROC:
    Dim strErrMsg As String
    Dim lngErrIconBtn As Long
    
    strErrMsg = "Error " & Err.Number & " (" & Err.Description & ") " _
        & "occurred in procedure Encrypt of " _
        & "VBA Document basEncryptDecrypt"
    lngErrIconBtn = vbOKOnly + vbInformation

    MsgBox strErrMsg, lngErrIconBtn, "Error"
    
    Resume exit_PROC

    
End Function


' Prefix inserted before masked passwords.
' Move to declarations area.
Global Const PASSWORD_PREFIX = "ĄżĄ"


Public Function MaskPassword(inp As Variant) As Variant
' Returns masked version of a password
' Author unknown
    If IsNull(inp) Then
        MaskPassword = Null
    ElseIf Left(inp, Len(PASSWORD_PREFIX)) = PASSWORD_PREFIX And Len(PASSWORD_PREFIX) > 0 Then
        MaskPassword = inp
    Else
        Dim i As Integer
        For i = 1 To Len(inp)
            MaskPassword = MaskPassword & Chr(Asc(Mid(inp, i, 1)) + (i ^ 3 Mod 10) + 10)
        Next i
        MaskPassword = PASSWORD_PREFIX & MaskPassword
    End If
End Function

Public Function UnmaskPassword(inp As Variant) As Variant
' Undoes the password mask
' Author unknown
    If IsNull(inp) Then
        UnmaskPassword = Null
    ElseIf False Then
        UnmaskPassword = inp
    Else
        Dim i As Integer
        For i = 1 To Len(inp)
            UnmaskPassword = UnmaskPassword & Chr(Asc(Mid(inp, i, 1)) - (i ^ 3 Mod 10) - 10)
        Next i
        UnmaskPassword = Mid(UnmaskPassword, Len(PASSWORD_PREFIX) + 1)
    End If
End Function