Stuart McLachlan
stuart at lexacorp.com.pg
Tue Jan 6 22:12:04 CST 2004
On 6 Jan 2004 at 21:26, Robert Gracie wrote:
> Hello All,
> Instead of re-inventing the wheel here, does anyone have some code that
> will allow me to pull the body of an e-mail (or a very large string even)
> and encrypt it with out first writing it to a text file? I've tried three
> different cipher routines, but they all want to break up the String. So I'm
> left with only the first section in the string....
>
How large is large?
Here are some routines that use PC1 (see
http://membres.lycos.fr/pc1/)
Theorectically, it will handle any length of string up to 1/2 the
maximum allowable string length for your development environment.
(The encryted string is always exactly twice as large as the
original.)
This VBA versions works fairly well up to about 30 - 40K on my PC
(1 -2 secs to encode, virtually instantaneous decode), but as the
original string gets bigger, it takes *a lot* longer to encrypt.
(70K = 12 secs, 80K = 22 secs, 90K = 38 secs etc but decrypt is still
only about 3 secs at 90K).
If you want to use larger strings, I can let you have a DLL version
of this which I built in PowerBasic. It is *much* faster
Option Compare Database
Option Explicit
'-----------------------------------------------------------------------------------------------------
'(A little) More info on this algo can be found at [URL=http://www.multimania.com/cuisinons/pc1/index.html]http://www.multimania.com/cuisinons/pc1/index.html[/URL]
'Ported from VB to PB by Wayne Diamond. The PC1 cipher uses a 128-bit key.
'It's a stream cipher with a retroaction function.
'Ported from PB to Access VBA by Stuart McLachlan
'-----------------------------------------------------------------------------------------------------
Global x1aZero() As Long, cle() As Long
'----------------------------------------------------------------------------------
Function code(x1aTwo As Long, EDsi As Long, EDi As Long) As Long
Dim EDax As Long, EDbx As Long, EDcx As Long, EDdx As Long, EDtemp As Long
On Error Resume Next
EDdx = (x1aTwo + EDi) Mod 65536
EDax = x1aZero(EDi)
EDcx = &H15A
EDbx = &H4E35
EDtemp = EDax
EDax = EDsi
EDsi = EDtemp
EDtemp = EDax
EDax = EDdx
EDdx = EDtemp
If (EDax <> 0) Then
EDax = (EDax * EDbx) Mod 65536
End If
EDtemp = EDax
EDax = EDcx
EDcx = EDtemp
If (EDax <> 0) Then
EDax = (EDax * EDsi) Mod 65536
EDcx = (EDax + EDcx) Mod 65536
End If
EDtemp = EDax
EDax = EDsi
EDsi = EDtemp
EDax = (EDax * EDbx) Mod 65536
EDdx = (EDcx + EDdx) Mod 65536
EDax = EDax + 1
x1aTwo = EDdx
x1aZero(EDi) = EDax
code = EDax Xor EDdx
EDi = EDi + 1
End Function
'----------------------------------------------------------------------------------
Function Assemble(x1aTwo As Long, EDsi As Long, EDi As Long) As Long
On Error Resume Next
Dim inter As Long
x1aZero(0) = ((cle(1) * 256) + cle(2)) Mod 65536
inter = code(x1aTwo, EDsi, EDi)
x1aZero(1) = x1aZero(0) Xor ((cle(3) * 256) + cle(4))
inter = inter Xor code(x1aTwo, EDsi, EDi)
x1aZero(2) = x1aZero(1) Xor ((cle(5) * 256) + cle(6))
inter = inter Xor code(x1aTwo, EDsi, EDi)
x1aZero(3) = x1aZero(2) Xor ((cle(7) * 256) + cle(8))
inter = inter Xor code(x1aTwo, EDsi, EDi)
x1aZero(4) = x1aZero(3) Xor ((cle(9) * 256) + cle(10))
inter = inter Xor code(x1aTwo, EDsi, EDi)
x1aZero(5) = x1aZero(4) Xor ((cle(11) * 256) + cle(12))
inter = inter Xor code(x1aTwo, EDsi, EDi)
x1aZero(6) = x1aZero(5) Xor ((cle(13) * 256) + cle(14))
inter = inter Xor code(x1aTwo, EDsi, EDi)
x1aZero(7) = x1aZero(6) Xor ((cle(15) * 256) + cle(16))
Assemble = inter Xor code(x1aTwo, EDsi, EDi)
EDi = 0
End Function
'----------------------------------------------------------------------------------
Function PC1ENC(encPassword As String, encStringOut As String) As String
On Error Resume Next
Dim encStringIn As String, ChmpStr As String
Dim j As Long, cfc As Long, cfd As Long, c As Long, D As Long, E As Long
Dim Chmp As Long, compte As Long
Dim x1aTwo As Long, EDsi As Long, EDi As Long, inter As Long
ReDim x1aZero(9) As Long, cle(17) As Long
encStringIn = ""
EDsi = 0
x1aTwo = 0
EDi = 0
For j = 1 To 16
cle(j) = 0
Next j
ChmpStr = encPassword
Chmp = Len(ChmpStr)
For j = 1 To Chmp
cle(j) = Asc(Mid$(ChmpStr, j, 1))
Next j
ChmpStr = encStringOut
Chmp = Len(ChmpStr)
For j = 1 To Chmp
c = Asc(Mid$(ChmpStr, j, 1))
inter = Assemble(x1aTwo, EDsi, EDi)
cfc = (((inter / 256) * 256) - (inter Mod 256)) / 256
cfd = inter Mod 256
For compte = 1 To 16
cle(compte) = cle(compte) Xor c
Next compte
c = c Xor (cfc Xor cfd)
D = (((c / 16) * 16) - (c Mod 16)) / 16
E = c Mod 16
encStringIn = encStringIn + Chr$(&H61 + D) ' d+&h61 give one letter range from a to p for the 4 high bits of c
encStringIn = encStringIn + Chr$(&H61 + E) ' e+&h61 give one letter range from a to p for the 4 low bits of c
Next j
PC1ENC = encStringIn
End Function
'----------------------------------------------------------------------------------
Function PC1DEC(encPassword As String, encStringIn As String) As String
On Error Resume Next
Dim encStringOut As String, ChmpStr As String
Dim j As Long, cfc As Long, cfd As Long, c As Long, D As Long, E As Long
Dim Chmp As Long, compte As Long
Dim x1aTwo As Long, EDsi As Long, EDi As Long, inter As Long
ReDim x1aZero(9) As Long, cle(17) As Long
encStringOut = ""
EDsi = 0
x1aTwo = 0
EDi = 0
For j = 1 To 16
cle(j) = 0
Next j
ChmpStr = encPassword
Chmp = Len(ChmpStr)
For j = 1 To Chmp
cle(j) = Asc(Mid$(ChmpStr, j, 1))
Next j
ChmpStr = encStringIn
Chmp = Len(ChmpStr)
For j = 1 To Chmp
D = Asc(Mid$(ChmpStr, j, 1))
If (D - &H61) >= 0 Then
D = D - &H61 ' to transform the letter to the 4 high bits of c
If (D >= 0) And (D <= 15) Then
D = D * 16
End If
End If
If (j <> Chmp) Then
j = j + 1
End If
E = Asc(Mid$(ChmpStr, j, 1))
If (E - &H61) >= 0 Then
E = E - &H61 ' to transform the letter to the 4 low bits of c
If (E >= 0) And (E <= 15) Then
c = D + E
End If
End If
inter = Assemble(x1aTwo, EDsi, EDi)
cfc = (((inter / 256) * 256) - (inter Mod 256)) / 256
cfd = inter Mod 256
c = c Xor (cfc Xor cfd)
For compte = 1 To 16
cle(compte) = cle(compte) Xor c
Next compte
encStringOut = encStringOut + Chr$(c)
Next j
PC1DEC = encStringOut
End Function
'----------------------------------------------------------------------------------
Function test() As Long
Dim strPassword As String
Dim strOriginal As String
Dim strEncode As String
Dim strDecode As String
strPassword = "12345678901" ' Max 11 Numbers it seems or ...
strPassword = "abcdefghijklmno" ' around 16 letters is maximum
strOriginal = String$(32000, "A")
starttime = Timer
strEncode = PC1ENC(strPassword, strOriginal)
Debug.Print "Encoded in " & CInt(Timer - starttime) & " secs"
Open "c:\test1.txt" For Output As #1
Print #1, strEncode
Close #1
starttime = Timer
strDecode = PC1DEC(strPassword, strEncode)
Debug.Print "Decoded in " & CInt(Timer - starttime) & " secs"
Open "c:\test2.txt" For Output As #1
Print #1, strDecode
Close #1
End Function
'----------------------------------------------------------------------------------
--
Lexacorp Ltd
http://www.lexacorp.com.pg
Information Technology Consultancy, Software Development,System
Support.