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