Ecrip Chipperh

Attribute VB_Name = "modEncryption"
'Coded by Tim Cinel, 15 Oct 2003
'This module is an example of some low-level encryption.

'Remember, when encrypting, we need a way to get our original message back
'so do not ever use Rnd (Random Function). I suggest using a Calculated
'Random Number generater that requires an input.

Function Encrypt(strPassword As String, strInput As String) As String
Dim PasswordVal As Long, CurrentChar As Long, CurrentMod As Long

'Lets turn our password into a number! Yippee!
PasswordVal = GetPasswordValue(strPassword)

'CurrentMod will makes it difficult to recognise when we use the same character more than once.
CurrentMod = 2

For i = 1 To Len(strInput)
CurrentChar = Asc(Mid(strInput, i, 1))
'Set currentchar as the ASCII value of the the character being encrypted
CurrentChar = CurrentChar + PasswordVal

'CurrentMod is passed into CalculateSeed - See that function for more details.
CurrentChar = CurrentChar - CalculateSeed(CLng(CurrentMod))

CurrentChar = WrapNumber(CurrentChar, 0, 255)

Encrypt = Encrypt & Chr(CurrentChar)

CurrentMod = CurrentMod + 1
If CurrentMod > 30 Then CurrentMod = 2
Next i
End Function

Function Decrypt(strPassword As String, strInput As String) As String
Dim PasswordVal As Long, CurrentChar As Long, CurrentMod As Long

'Lets turn our password into a number! Yippee!
PasswordVal = GetPasswordValue(strPassword)
CurrentMod = 2

For i = 1 To Len(strInput)
CurrentChar = Asc(Mid(strInput, i, 1))
'Set currentchar as the ASCII value of the the character being encrypted
CurrentChar = CurrentChar - PasswordVal

'CurrentMod is passed into CalculateSeed - See that function for more details.
CurrentChar = CurrentChar + CalculateSeed(CLng(CurrentMod))

'We need to make sure that CurrentChar ends up being between 0 and 255, so we wrap it!
CurrentChar = WrapNumber(CurrentChar, 0, 255)

Decrypt = Decrypt & Chr(CurrentChar)

'Add 1 to CurrentMod (For calculated randomization)
CurrentMod = CurrentMod + 1
If CurrentMod > 30 Then CurrentMod = 2
Next i
End Function

Private Function GetPasswordValue(strPassword As String) As Long
Dim ASCII_Vals As Long

For i = 1 To Len(strPassword)
'We need to add up all the ASCII values from all the characters
ASCII_Vals = ASCII_Vals + Asc(Mid(strPassword, i, 1))
Next i

If ASCII_Vals > Len(strPassword) Then
'Divide the Calculated Random Number (CRN) of ASCII_Vals by the CRN of the length of the password.
GetPasswordValue = Int(CalculateSeed(ASCII_Vals) / CalculateSeed(Len(strPassword) + 1))
Else
'We would end up with 0 if we divided, so we aint gonna divide!
'We will just use the CRN ASCII_Vals produces.
GetPasswordValue = CalculateSeed(ASCII_Vals)
End If

End Function

Private Function CalculateSeed(InputNumber As Long) As Long
'This functions pretty much makes the InputNumber appear to become a totally random
'number, but unke using rnd (Random Function) this will always return the same number
'as long as you enter the same number.

'Log and Cos are just Maths functions

CalculateSeed = Int(Log(InputNumber) * Cos(InputNumber) * 137)
End Function

Private Function WrapNumber(lngNumber As Long, lngMinimum As Long, lngMaximum As Long) As Long
Dim Range As Long
Range = lngMaximum - lngMinimum
'This function 'wraps' numbers.
'If u want a number to be in a certain range (say between 0 and 255)
'this funciton will make any number fit into that range!
WrapNumber = lngNumber

If lngNumber > lngMaximum Then
Do Until WrapNumber <= lngMaximum
WrapNumber = WrapNumber - Range
Loop
ElseIf lngNumber < lngMinimum Then
Do Until WrapNumber >= lngMinimum
WrapNumber = WrapNumber + Range
Loop
End If

End Function