Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : NAN0304.ZIP
Filename : CRYPT.PRG

* Program: Crypt.prg
* Author: Gerry S. Braganza
* Version: Clipper Summer '87
* Note(s): Encryption/decryption program.
*
* Copyright (c) 1988 Nantucket Corp. All Rights Reserved.

PUBLIC key

* Initialize key containing characters found in the database.
key=[AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz.,]+;
[(1234567890)`&'#-/:" ]

PUBLIC code[75] && Initialize array that holds table.

code[1] = "T"
code[2] = "h"
code[3] = "E"
code[4] = "9"
code[5] = "q"
code[6] = "U"
code[7] = "i"
code[8] = "C"
code[9] = "k"
code[10] = "B"
code[11] = "r"
code[12] = "O"
code[13] = "w"
code[14] = "N"
code[15] = "f"
code[16] = "X"
code[17] = "j"
code[18] = "M"
code[19] = "p"
code[20] = "D"
code[21] = "v"
code[22] = "7"
code[23] = "L"
code[24] = "a"
code[25] = "Z"
code[26] = "y"
code[27] = "G"
code[28] = "5"
code[29] = "3"
code[30] = "t"
code[31] = "H"
code[32] = "e"
code[33] = "1"
code[34] = "Q"
code[35] = "u"
code[36] = "I"
code[37] = "c"
code[38] = "K"
code[39] = "b"
code[40] = "R"
code[41] = "o"
code[42] = "W"
code[43] = "n"
code[44] = "F"
code[45] = "x"
code[46] = "J"
code[47] = "m"
code[48] = "P"
code[49] = "d"
code[50] = "V"
code[51] = "0"
code[52] = "l"
code[53] = "A"
code[54] = "z"
code[55] = "Y"
code[56] = "8"
code[57] = ">"
code[58] = "6"
code[59] = "<"
code[60] = "4"
code[61] = "+"
code[62] = "2"
code[63] = "/"
code[64] = "^"
code[65] = "*"
code[66] = ";"
code[67] = "?"
code[68] = ":"
code[69] = "|"
code[70] = "`"
code[71] = "="
code[72] = "$"
code[73] = "@"
code[74] = "!"
code[75] = "{"
CLEAR SCREEN

curr_color = "w+/b, gr+/r" && Just to make it presentable!
oper_color = "gr+/r"

USE oradbf && Sample database.

SETCOLOR(curr_color)

@ 23, 0 SAY SPACE(80)
@ 23,0 SAY "Encrypting Record # "
DO WHILE .NOT. EOF()
SETCOLOR(oper_color)
@ 23, 20 SAY LTRIM(TRIM(STR(RECNO())))
REPLACE last_name WITH encrypt(last_name) && Pass field_name.
REPLACE first_name WITH encrypt(first_name)
SKIP
ENDDO
TONE(440,4)

SETCOLOR(curr_color)
@ 23, 0 SAY SPACE(80)
@ 23, 0 SAY "Encrytion COMPLETE!"
GO TOP
INKEY(0) && Wait awhile.
browse()
GO TOP
@ 23, 0 SAY SPACE(80)
@ 23, 0 SAY "Decrypting Record # "
DO WHILE .NOT. EOF()
SETCOLOR(oper_color)
@ 23, 21 SAY LTRIM(TRIM(STR(RECNO())))
REPLACE last_name WITH decrypt(last_name)
REPLACE first_name WITH decrypt(first_name)
SKIP
ENDDO
TONE(440,4)

SETCOLOR(curr_color)
@ 23, 0 SAY SPACE(80)
@ 23,0 SAY "Decryption COMPLETE!"
INKEY(0)
GO TOP
browse()
QUIT


* Function: encrypt()
*
FUNCTION encrypt
PARAMETERS fld_name && Fld name to encrypt.
PRIVATE x, char, pos, rep_key, f_name
f_name = fld_name && Temporary holder.

* Determine length of data.
x = LEN(TRIM(f_name))
* If blank, return spaces.
IF x = 0
fname = " "
ELSE
FOR I = 1 to x
* Slice character.
char = SUBSTR(f_name, i, 1)

* Determine position in key.
pos = AT(char, key)

* Take appropriate value from array.
rep_key = code[pos]

* Replace character with encrypted
* character.
f_name = STUFF(f_name, i, 1, rep_key)

* Continue with next character until whole
* string is processed.
NEXT
ENDIF
RETURN(f_name) && Return encryted string.


* Function: Decrypt()
*
FUNCTION Decrypt
PARAMETERS fld_name && Field name to decrypt.
PRIVATE x, rep_key, pos, char, f_name
f_name = fld_name && Temporary holder.

* Determine length of data.
x = LEN(TRIM(f_name))
* If blank, return spaces.
IF x = 0
f_name = " "
ELSE
FOR I = 1 to x
* Slice encrypted character.
rep_key = SUBSTR(f_name, i, 1)

* Search array and determine position.
pos = ASCAN(code, rep_key)

* Take appropriate value from key.
char = SUBSTR(key, pos, 1)

* Replace character with decrypted
* character.
f_name = STUFF(f_name, i, 1, char)

* Continue with next character until whole
* string is processed.
NEXT
ENDIF
RETURN(f_name) && Return decrypted string.