Lues <pr****@popmail.com> wrote in message news:<MP************************@news.tel.hr>...
Hi,
I'm trying to protect some data in tables with encription (you know why,
don't you ;))
I must confess that I'm not very expirienced in writing code, especially
encription code.
Can any one, please , send VB code for access which I can c/p into one
function. It don't have to be RSA, it can be anything which is easy to
use and which will make data in tables unreadeable for non authorized
persons.
Thank you very much
--
I published this stuff a long time ago, it's based on a "One Time Pad"
concept, which means it's fast, easy, and ETHIER very strong or very
weak depending on YOUR implementation. I also included a keyed PRNG
(Pseudo Random Number Generator) at the end.
Test, test, and re-test your implementation before going live, the
only differance between trashed data and encrypted data is the ability
to decrypt it!!!
Be carefull, have fun.
<%
' 1) Never user the same key within the pad on two different pieces of
data!
' 2) Be creative when designing your GenPad algorithms, guessing the
seed and repeat values seems
' to be the easiest way for an hacker to attack a well implemented
one time pad.
' 3) Don't encrypt known text that would be normally displayed to a
user. This wouldn't seem to be
' an issue if you mind point one, but since the code for the Rnd
function is known, obtaining a
' valid key sequence can narrow possibilities for a hacker.
' WizPad
' Generates the WizKey(array) pad of key bytes that are then Xor-ed
with each character within an
' plain text input string to create crypto text. WizPad size
parameter can create a WizKey(array)
' pad of any size and WizKey arrays are repeatable by reissuing a
WizPad statement with identical
' parameters. WizPad's Seed and Repeat paramters can be any number
value although WizPad will
' force a non-negative Repeat value to a negative number which is a
requirement of MS's repeatable
' randomize process.
' *** IMPORTANT NOTE *** WizPad's repeatability concept should not be
confused with the general
' concept of reusability, which is the "Kiss of Death" for a one time
pad. One time pad keys should
' never be used to encrypt more than one character per pad use.
WizPad's repeatability concept must
' only be used to decrypt an encrypted string using the same set of
keys. You may however, create a
' single pad large enough to en/decrypt all information on single
page provided you don't use the
' same key twice.
' GenPad
' This routine's only purpose is to generate the seed and repeat
number for WizPad. The reason it is
' separate from WizPad is because any algorithem that is used, may
only be used for one client and
' may not be published for obvious security reasons. Whatever
algorithem is used must be repeatable,
' remember the same WizPad key must be regenerated to decrypt the
crypto text.
' WizET(), WizDT()
' Encrypts and decrypts text strings using a one time pad scheme.
' Basically we run WizPad to create the WizKey(array) pad of bytes to
Xor with each character within an
' input string to create crypto text. The crypto text can then be Xor
with WizKey(array) pad to
' reversed the crypto and retrieve the original input string.
' WizEH(), WizDH()
' Really a derivative of WizET(), WizDT() except WizEH() produces a
crypto hex output and WizDH()
' requires a crypto hex intput. Very fast, but the hex output is
double the length of the imput.
' WizEM(), WizDM()
' These routines call WizET()and WizDT() for the actual encryption
and decryption then call encode64
' and decode64 for the conversion. WizEH() produces a crypto map64
output and WizDH()
' requires a crypto map64 input. Slower than WizEH(), WizDH(), but
the map64 output is of less
' length than hex.
' Encode64(), Decode64()
' Maps text strings to and from characters defined by their position
in the constant Map64 based
' the trusty old uu, xx, base64 3 divided by 4 algorithm.
' Base64 is an algorithm used to convert binary data to printable text
for transmission, and once
' received, converted back to the original binary data. Basically we
treat the input string as a
' stream of 24 bit triplicates (3x8 bit bytes or characters called
octets). Each 24 bit triplicate
' is first split into 4x6 bit values called quartets, then each
quartet is mapped to the printable
' character occupying the position of its 6 bit((0-63.)+1) value in
the Map64 constant. The process
' is then reversed to retrieve the original input string.
Dim WizKey() ' encrypt key
array
Dim WizSeed ' WizPad Seed
Dim WizRepeat ' WizPad
Repeat
Const MAP64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw xyz0123456789-_"
Sub WizPad(Size, Seed, Repeat) ' routine to
generate random key array
Dim i ' array count
ReDim WizKey(Size) ' build key
array to size
If Sgn(Repeat) = True Then Repeat = Not Repeat ' make sure
repeat is negative
Rnd Repeat ' initialize
random-number generator for repeatable sequence
Randomize Seed ' seed
random-number generator
For i = 1 To Size ' initialize
key loop
WizKey(i) = Int((255 * Rnd) + 0) ' load array
with random key value between 0 and 255
Next ' next key
End Sub ' WizPad
Sub GenPad(Size) ' routine to
generate secret Seed and Repeat values for WizPad
'*** YOUR UNIQUE ALGORITHM REPLACES THE NEXT TWO LINES ***
WizSeed = 1100.123 ' ***
DEMONSTRATION PURPOSES ONLY ***
WizRepeat = -2200.321 ' ***
DEMONSTRATION PURPOSES ONLY ***
WizPad Size, WizSeed, WizRepeat ' generate
random key array
End Sub ' GenPad
Function WizET(Plain) ' routine to
encrypt plain text to crypto text
Dim i ' array count
For i = 1 To Len(Plain) ' loop through
plain text
WizET = WizET & Chr(WizKey(i) Xor Asc(Mid(Plain, i, 1)))
Next ' next plain
text character
End Function ' WizET
Public Function WizDT(Crypt) ' routine to
decrypt crypto text back to plain text
Dim i ' array count
For i = 1 To Len(Crypt) ' loop
encrypted text
WizDT = WizDT & Chr(WizKey(i) Xor Asc(Mid(Crypt, i, 1)))
Next ' next
encrypted text character
End Function ' WizDT
Function WizEH(Text) ' routine to
encrypt plain text to crypto hex values
Dim i ' text length
Dim h ' hex value
For i = 1 To Len(Text) ' loop through
plain text
h = Hex(WizKey(i) Xor Asc(Mid(Text, i, 1))) ' create hex
value of encrypted character
If Len(h) = 1 Then h = "0" & h ' if hex value
needs leading zero, add it
WizEH = WizEH & h ' add
encrypted hex value to return string
Next ' next plain
text character
End Function ' WizEH
Function WizDH(Crypt) ' routine to
decrypt crypto hex values back to plain text
Dim i ' text length
Dim k ' key pointer
Dim v ' hex string
value
k = 1 ' start key
pointer
For i = 1 To Len(Crypt) Step 2 ' loop
encrypted hex values
v = "&H" & Mid(Crypt, i, 2) ' create hex
value
WizDH = WizDH & Chr(WizKey(k) Xor v) ' return plain
text
k = k + 1 ' increament
key pointer
Next ' next
encrypted hex value
End Function ' WizDH
Function WizEM(Text) ' routine to
encrypt plain text to crypto map64 values
WizEM = Encode64(WizET(Text)) '
End Function ' WizEM
Function WizDM(Crypt) ' routine to
decrypt crypto hex values back to plain text
WizDM = WizDT(Decode64(Crypt))
End Function ' WizDM
Function Encode64(Text) ' routine to
encode text to map64
Dim t ' triplicate
Dim i ' pointer
For i = 1 To (Len(Text) \ 3) * 3 Step 3 ' loop through
octets
' build 24 bit triplicate
t = (Asc(Mid(Text, i, 1)) * 65536) + (Asc(Mid(Text, i + 1, 1)) *
CLng(256)) + Asc(Mid(Text, i + 2, 1))
' extract four 6 bit quartets from triplicate
Encode64 = Encode64 & Mid(Map64, (t \ 262144) + 1, 1) & Mid(Map64, ((t
And 258048) \ 4096) + 1, 1) & Mid(Map64, ((t And 4032) \ 64) + 1, 1) &
Mid(Map64, (t And 63) + 1, 1)
Next ' next octet
Select Case Len(Text) Mod 3
Case 1
t = (Asc(Mid(Text, i, 1)) * 65536)
Encode64 = Encode64 & Mid(Map64, (t \ 262144) + 1, 1) & Mid(Map64,
((t And 258048) \ 4096) + 1, 1)
Case 2
t = (Asc(Mid(Text, i, 1)) * 65536) + (Asc(Mid(Text, i + 1, 1)) *
CLng(256))
Encode64 = Encode64 & Mid(Map64, (t \ 262144) + 1, 1) & Mid(Map64,
((t And 258048) \ 4096) + 1, 1) & Mid(Map64, ((t And 4032) \ 64) + 1,
1)
End Select
End Function
Function Decode64(Mapped64) ' routine to
encode map64 to text
Dim t ' triplicate
Dim i ' string
pointer
For i = 1 To (Len(Mapped64) \ 4) * 4 Step 4 ' loop through
quartets
' build 24 bit triplicate
t = (InStr(1, Map64, Mid(Mapped64, i, 1), 0) - 1) * 262144 +
(InStr(1, Map64, Mid(Mapped64, i + 1, 1), 0) - 1) * 4096 + (InStr(1,
Map64, Mid(Mapped64, i + 2, 1), 0) - 1) * 64 + InStr(1, Map64,
Mid(Mapped64, i + 3, 1), 0) - 1
' extract three 8 bit octets from triplicate
Decode64 = Decode64 & Chr(t \ 65536) & Chr((t And 65280) \ 256) &
Chr(t And 255)
Next ' next quartet
Select Case Len(Mapped64) Mod 4
Case 1
t = (InStr(1, Map64, Mid(Mapped64, i, 1), 0) - 1) * 262144
Decode64 = Decode64 & Chr(t \ 65536)
Case 2
t = (InStr(1, Map64, Mid(Mapped64, i, 1), 0) - 1) * 262144 +
(InStr(1, Map64, Mid(Mapped64, i + 1, 1), 0) - 1) * 4096
Decode64 = Decode64 & Chr(t \ 65536)
If ((t And 65280) \ 256) > 0 Then Decode64 = Decode64 & Chr((t And
65280) \ 256)
Case 3
t = (InStr(1, Map64, Mid(Mapped64, i, 1), 0) - 1) * 262144 +
(InStr(1, Map64, Mid(Mapped64, i + 1, 1), 0) - 1) * 4096 + (InStr(1,
Map64, Mid(Mapped64, i + 2, 1), 0) - 1) * 64
Decode64 = Decode64 & Chr(t \ 65536) & Chr((t And 65280) \ 256)
If (t And 255) > 0 Then Decode64 = Decode64 & Chr(t And 255)
End Select
End Function
%>
' **** Pseudo Random Number Generator
Option Compare Database
Option Explicit
' Preliminary Key Setup:
' Allocate an 256 element array of 8 bit bytes to be used for rand():
R(0) .. R(255).
Dim R(255) As Byte ' random byte array
Dim t As Byte ' temporary swap key
value storage
Dim i As Integer ' known first index
value
Dim j As Integer ' unknown second index
value
Public Sub PrngInit(Key As String)
' Pseudo Random Key Initialization
Dim kl As Integer ' key length
kl = Len(Key) ' get key length
' Initialize random array with equal number distribution. Fill each
element first with it's
' index: R(0) = 0; R(1) = 1; etc. up to R(255) = 255
For i = 0 To 255 ' random array loop ()
R(i) = i ' random byte is index
Next i ' next random byte
element
' Set j to zero and initialize the random array with the key like
this, repeating key bytes
' as necessary:
For i = 0 To 255 ' randomize array loop
' j = (j + R(i) + key[i Mod keylen]) Mod 256
j = (j + R(i) + Asc(Mid(Key, (i Mod kl) + 1, 1))) And 255
' randomize
t = R(i) ' save known index value
to temporary storage
R(i) = R(j) ' replace known index
value with unknown index value
R(j) = t ' replace unknown index
value with saved known index value
Next i ' next random array
element
i = 0 ' init for PrngRand
j = 0 ' init for PrngRand
PrintRandArry
End Sub
Private Function PrngRand() As Byte
' Pseudo Random Number Generation
Dim z As Integer ' unknown second index
value
i = (i + 1) And 255 ' set unknown first
index value
j = (j + R(i)) And 255 ' set unknown second
index value
' randomize
t = R(i) ' save known index value
to temporary storage
R(i) = R(j) ' replace known index
value with unknown index value
R(j) = t ' replace unknown index
value with saved known index value
z = R(i)
z = (z + R(j)) And 255
PrngRand = R(z) ' return random byte
End Function