home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NANNWS34.ARC / CRYPT.PRG < prev    next >
Encoding:
Text File  |  1989-01-01  |  4.1 KB  |  204 lines
  1. * Program: Crypt.prg
  2. * Author:  Gerry S. Braganza
  3. * Version: Clipper Summer '87
  4. * Note(s): Encryption/decryption program.
  5. *
  6. * Copyright (c) 1988 Nantucket Corp. All Rights Reserved.
  7.  
  8. PUBLIC key
  9.  
  10. * Initialize key containing characters found in the database.
  11. key=[AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz.,]+;
  12.     [(1234567890)`&'#-/:" ]                
  13.  
  14. PUBLIC code[75]              && Initialize array that holds table.
  15.  
  16. code[1] = "T"
  17. code[2] = "h"
  18. code[3] = "E"
  19. code[4] = "9"
  20. code[5] = "q"
  21. code[6] = "U"
  22. code[7] = "i"
  23. code[8] = "C"
  24. code[9] = "k"
  25. code[10] = "B"
  26. code[11] = "r"
  27. code[12] = "O"
  28. code[13] = "w"
  29. code[14] = "N"
  30. code[15] = "f"
  31. code[16] = "X"
  32. code[17] = "j"
  33. code[18] = "M"
  34. code[19] = "p"
  35. code[20] = "D"
  36. code[21] = "v"
  37. code[22] = "7"
  38. code[23] = "L"
  39. code[24] = "a"
  40. code[25] = "Z"
  41. code[26] = "y"
  42. code[27] = "G"
  43. code[28] = "5"
  44. code[29] = "3"
  45. code[30] = "t"
  46. code[31] = "H"
  47. code[32] = "e"
  48. code[33] = "1"
  49. code[34] = "Q"
  50. code[35] = "u"
  51. code[36] = "I"
  52. code[37] = "c"
  53. code[38] = "K"
  54. code[39] = "b"
  55. code[40] = "R"
  56. code[41] = "o"
  57. code[42] = "W"
  58. code[43] = "n"
  59. code[44] = "F"
  60. code[45] = "x"
  61. code[46] = "J"
  62. code[47] = "m"
  63. code[48] = "P"
  64. code[49] = "d"
  65. code[50] = "V"
  66. code[51] = "0"
  67. code[52] = "l"
  68. code[53] = "A"
  69. code[54] = "z"
  70. code[55] = "Y"
  71. code[56] = "8"
  72. code[57] = ">"
  73. code[58] = "6"
  74. code[59] = "<"
  75. code[60] = "4"
  76. code[61] = "+"
  77. code[62] = "2"
  78. code[63] = "/"
  79. code[64] = "^"
  80. code[65] = "*"
  81. code[66] = ";"
  82. code[67] = "?"
  83. code[68] = ":"
  84. code[69] = "|"
  85. code[70] = "`"
  86. code[71] = "="
  87. code[72] = "$"
  88. code[73] = "@"
  89. code[74] = "!"
  90. code[75] = "{"
  91. CLEAR SCREEN
  92.  
  93. curr_color = "w+/b, gr+/r"        && Just to make it presentable!
  94. oper_color = "gr+/r"
  95.  
  96. USE oradbf                        && Sample database.
  97.  
  98. SETCOLOR(curr_color)
  99.  
  100. @ 23, 0 SAY SPACE(80)
  101. @ 23,0 SAY "Encrypting Record # "
  102. DO WHILE .NOT. EOF()
  103.    SETCOLOR(oper_color)
  104.    @ 23, 20 SAY LTRIM(TRIM(STR(RECNO())))
  105.    REPLACE last_name WITH encrypt(last_name)   && Pass field_name.
  106.    REPLACE first_name WITH encrypt(first_name)
  107.    SKIP
  108. ENDDO
  109. TONE(440,4)
  110.  
  111. SETCOLOR(curr_color)
  112. @ 23, 0 SAY SPACE(80)
  113. @ 23, 0 SAY "Encrytion COMPLETE!"
  114. GO TOP
  115. INKEY(0)                      && Wait awhile.
  116. browse()
  117. GO TOP
  118. @ 23, 0 SAY SPACE(80)
  119. @ 23, 0 SAY "Decrypting Record # "
  120. DO WHILE .NOT. EOF()
  121.    SETCOLOR(oper_color)
  122.    @ 23, 21 SAY LTRIM(TRIM(STR(RECNO())))
  123.    REPLACE last_name WITH decrypt(last_name)
  124.    REPLACE first_name WITH decrypt(first_name)
  125.    SKIP
  126. ENDDO 
  127. TONE(440,4)
  128.  
  129. SETCOLOR(curr_color)
  130. @ 23, 0 SAY SPACE(80)
  131. @ 23,0 SAY "Decryption COMPLETE!"
  132. INKEY(0)
  133. GO TOP
  134. browse()
  135. QUIT
  136.  
  137.  
  138. * Function: encrypt()
  139. *
  140. FUNCTION encrypt
  141. PARAMETERS fld_name    && Fld name to encrypt.
  142. PRIVATE x, char, pos, rep_key, f_name
  143. f_name = fld_name      && Temporary holder.
  144.  
  145. * Determine length of data.
  146. x = LEN(TRIM(f_name))
  147. * If blank, return spaces.
  148. IF x = 0
  149.    fname = " "
  150. ELSE
  151.    FOR I = 1 to x
  152.       * Slice character.
  153.       char = SUBSTR(f_name, i, 1)
  154.       
  155.       * Determine position in key.
  156.       pos  =  AT(char, key)
  157.  
  158.       * Take appropriate value from array.
  159.       rep_key = code[pos]
  160.  
  161.       * Replace character with encrypted
  162.       * character.
  163.       f_name = STUFF(f_name, i, 1, rep_key)
  164.  
  165.    * Continue with next character until whole
  166.    * string is processed.
  167.    NEXT
  168. ENDIF
  169. RETURN(f_name)     && Return encryted string.
  170.  
  171.  
  172. * Function: Decrypt()
  173. *
  174. FUNCTION Decrypt
  175. PARAMETERS fld_name  && Field name to decrypt.
  176. PRIVATE x, rep_key, pos, char, f_name
  177. f_name = fld_name    && Temporary holder.
  178.  
  179. * Determine length of data.
  180. x = LEN(TRIM(f_name))
  181. * If blank, return spaces.
  182. IF x = 0
  183.    f_name = " "
  184. ELSE
  185.    FOR I = 1 to x
  186.       * Slice encrypted character.
  187.       rep_key = SUBSTR(f_name, i, 1)
  188.  
  189.       * Search array and determine position.
  190.       pos = ASCAN(code, rep_key)
  191.  
  192.       * Take appropriate value from key.
  193.       char = SUBSTR(key, pos, 1)
  194.  
  195.       * Replace character with decrypted
  196.       * character.
  197.       f_name = STUFF(f_name, i, 1, char)
  198.  
  199.    * Continue with next character until whole
  200.    * string is processed.
  201.    NEXT
  202. ENDIF
  203. RETURN(f_name)     && Return decrypted string.
  204.