'===================================================================================
' Module:       Security
' Version:      1
' Author:       Lee Cowdrey - Syntex Development Research
' Date:         1 August 1994
' Description:  Allows for strings to be encrypted and decrypted
'
' Limitations:  Upon decrypting strings, the return characters are all uppercase !
'
' Usage:        To encrypt do
'
'                   encrypted_string_var = encrypt("text")
'
'               To decrypt do
'
'                   decrypted_string_var = decrypt(encrypted_string_var)
'
' Functions:    Decode          Decode a character byte
'               Decrypt         Decrypt an entire string
'               Encode          Encode a character byte
'               Encrypt         Encrypt an entire string
'               Find_Pow_Mod    Calculates powers/modulos
'
' Example:
'               debug.print encrypt("Lee Cowdrey")
'               yetbo[9 ee2
'
'               debug.print decrypt("yetbo[9 ee2")
'               LEE COWDREY
'
'===================================================================================
Option Compare Database   'Use database order for string comparisons
Option Explicit

Const Charset = "!#$%&'()*+,-./0123456789:;<=>@abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ "

Function Decode (Initial As Integer) As Long

 Decode = Find_Pow_Mod(Initial, 13, 62)

End Function

Function Decrypt (In_Text As String) As String

Dim Idx As Integer, Out_Text As String
Dim Old_Text() As String, New_Text() As String, Array_Length As Integer
Dim temp As Integer, NewIdx As Integer

 '
 ' Test for nulls
 '
 If IsNull(In_Text) Then
  Decrypt = Null
  Exit Function
 End If
 '
 ' Resize arrays to correct length
 '
 Array_Length = Len(In_Text)
 ReDim Old_Text(Array_Length)
 ReDim New_Text(Array_Length)
 '
 ' Copy string byte by byte
 '
 For Idx = Array_Length To 1 Step -1
  NewIdx = (Array_Length - Idx) + 1
  Old_Text(NewIdx) = UCase$(Mid$(In_Text, Idx, 1))
 Next Idx
 '
 ' Encrypt old string
 '
 For Idx = 1 To Array_Length Step 1
  New_Text(Idx) = Chr$(Encode(Asc(Old_Text(Idx)) - 33) + 33)
 Next Idx
 
 '
 ' Copy new string byte by byte
 '
 For Idx = 1 To Array_Length Step 1
  If Len(Out_Text) = 0 Then
   Out_Text = New_Text(Idx)
  Else
   Out_Text = Out_Text + New_Text(Idx)
  End If
 Next Idx

 Decrypt = Out_Text

End Function

Function Encode (Initial As Integer) As Long

 Encode = Find_Pow_Mod(Initial, 7, 62)

End Function

Function Encrypt (In_Text As String) As String

Dim Idx As Integer, Out_Text As String
Dim Old_Text() As String, New_Text() As String, Array_Length As Integer
Dim temp As Integer, NewIdx As Integer, TChar As String

 '
 ' Test for nulls
 '
 If IsNull(In_Text) Then
  Encrypt = Null
  Exit Function
 End If
 '
 ' Resize arrays to correct length
 '
 Array_Length = Len(In_Text)
 ReDim Old_Text(Array_Length)
 ReDim New_Text(Array_Length)
 '
 ' Copy string byte by byte
 '
 For Idx = Array_Length To 1 Step -1
  NewIdx = (Array_Length - Idx) + 1
  Old_Text(NewIdx) = UCase$(Mid$(In_Text, Idx, 1))
 Next Idx
 '
 ' Encrypt old string
 '
 For Idx = 1 To Array_Length Step 1
  TChar = Chr$(Find_Pow_Mod(Asc(Old_Text(Idx)) - 33, 13, 62) + 33)
  New_Text(Idx) = Mid$(Charset, InStr(1, Charset, TChar), 1)
 Next Idx
 '
 ' Copy new string byte by byte
 '
 For Idx = 1 To Array_Length Step 1
  If Len(Out_Text) = 0 Then
   Out_Text = New_Text(Idx)
  Else
   Out_Text = Out_Text + New_Text(Idx)
  End If
 Next Idx

 Encrypt = Out_Text

End Function

Function Find_Pow_Mod (a As Integer, b As Integer, c As Integer) As Integer

 If b = 1 Then
  Find_Pow_Mod = a Mod c
 Else
  Find_Pow_Mod = ((a Mod c) * Find_Pow_Mod(a, b - 1, c)) Mod c
 End If

End Function

