Public Function MakeArray(str, random)
Dim arrlen
arrlen = 2^(Fix(log(2)/log(Len(str))) + 1) + 8
If arrlen < 32 Then
arrlen = 32
End If
ReDim arr(arrlen-1)
If random=true Then
Randomize Timer
For i = 0 to arrlen-1
arr(i) = Asc(Mid(str,Int((9999 - 1000 + 1) * Rnd + 1000) mod Len(str) + 1,1))
Next
start = 1 + Int((9999 - 1000 + 1) * Rnd + 1000) mod (arrlen - Len(str) - 2)
For i = 1 to Len(str)
arr(start + i) = Asc(Mid(str,i,1))
Next
arr(start - 1) = 0
arr(start + Len(str)) = 0
Else
For i = 0 to arrlen-1
arr(i) = Asc(Mid(str,i mod Len(str) + 1,1))
Next
End If
MakeArray=arr
End Function
Public Function BasicFormat(vals)
Dim sb
sb = ""
For i=0 to UBound(vals)
If Len(sb) > 0 Then
sb = sb & "-"
End if
sb = sb & (vals(i)&"")
Next
BasicFormat=sb
End Function
Public Function BasicEncrypt(data, encryptkey)
If data=null Or Len(Trim(data))=0 Then
Err.Raise6
End If
If encryptkey=null Or Len(Trim(encryptkey))=0 Then
Err.Raise6
End If
vals = MakeArray(data, true)
keys = MakeArray(encryptkey, false)
EncryptLoopCount = 4
for t = 0 to EncryptLoopCount-1
for i = 0 to UBound(vals)
v = vals(i)
im = (v + i) mod 5
for x = 0 to UBound(vals)
if x <> i And x mod 5 = im Then
for y = 0 to UBound(keys)
k = keys(y)
if k <> 0 Then
vals(x) = vals(x) + v mod k
End if
Next
End If
Next
Next
Next
BasicEncrypt=BasicFormat(vals)
End Function