home *** CD-ROM | disk | FTP | other *** search
/ mail.altrad.com / 2015.02.mail.altrad.com.tar / mail.altrad.com / TEST / COMMERC_72_53 / PROGS / ENCODE.PRG < prev    next >
Text File  |  2014-04-10  |  9KB  |  322 lines
  1. PROCEDURE MAIN (CONTROL)     // To scramble or to unscramble !!!
  2. * Auteur...: R M ALCOCK
  3. * Date.....: 26/2/95
  4. * Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
  5. * Notes....: Subroutines to encode data
  6. *
  7. *
  8. #include "Inkey.ch"
  9. #include "Params"
  10. *
  11. LOCAL SEED,C
  12. DEFAULT CONTROL TO ""   // Decrypt
  13. *
  14. SET CONFIRM     ON
  15. SET DATE        FRENCH
  16. SET DELETED     ON
  17. SET EXACT       ON
  18. SET EXCLUSIVE   OFF
  19. SET FIXED       OFF
  20. SET SCOREBOARD  ON
  21. SET TALK        OFF
  22. SET BELL        OFF
  23. SET EPOCH TO 1980
  24.  
  25. PUBLIC LCD:=.T., M_Control
  26.  
  27. CLOSE DATABASES
  28. SELECT 1
  29. USE ATTACH
  30. M_Control = PCON         // Password Control
  31.  
  32. USE CLIENT EXCLUSIVE
  33.  
  34. SEED=VAL(READ_SEED(6,5,;
  35.          IIF (CONTROL="", "DECRYPTAGE FICHIER", "CODAGE FICHIER")))
  36. @ 6,0 CLEAR
  37.  
  38. IF CONTROL = ""
  39.    // Should be unscramble
  40.    GO TOP
  41.    COUNT NEXT 10 FOR CLISCRAMBL TO C
  42.    IF C < 10 .AND. .NOT. CONFIRM (5,,"N","CONFIRM DECRYPTAGE")
  43.          QUIT
  44.    ENDIF
  45.    //
  46.    GO TOP
  47.    @ 6,0 SAY "DECRYPTAGE FICHIER"
  48.  
  49.    DO WHILE .NOT. EOF()
  50.       SPEEDO (8,RECCOUNT())
  51.       UNSCRAM_CLI(SEED)
  52.       SKIP
  53.    ENDDO
  54.    //
  55. ELSE
  56.    //
  57.    @ 6,0 SAY "CODAGE FICHIER"
  58.  
  59.    DO WHILE .NOT. EOF()
  60.       SPEEDO (8,RECCOUNT())
  61.       SCRAM_CLI(SEED)
  62.       SKIP
  63.    ENDDO
  64. ENDIF
  65. ?"Indexation REF"
  66. INDEX ON CLIREF TO CLIREF
  67. ?"Indexation CODE POSTALE"
  68. INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
  69. ?"Indexation NOM"
  70. INDEX ON CLINOM TO CLINOM
  71. //
  72. //
  73. RETURN
  74. //
  75. //
  76. //-------------------------------------------------------------------------
  77. //
  78. // Function scrambles a CLIENT record
  79. //
  80. FUNCTION SCRAM_CLI (SEED)
  81. //
  82. // SEED is the seed for the random number generator
  83. //
  84. LOCAL M_FIX:= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
  85. LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31)    // 30 codes.
  86. LOCAL M,N
  87. //
  88. // M_FIX is used for those variables which are indexed and therefore must
  89. // use the same translation for all
  90. //
  91. // M_VAR increases the degree of randomness because the seed is different
  92. // for each record. Hence the translation is different for the same
  93. // parameters in different records
  94. //
  95. //
  96. IF CLISCRAMBL
  97.    RETURN .T.        // Already scrambled
  98. ENDIF
  99. //
  100. // Scramble CLINOM and VILLE  using fixed translation for the first 5 chars
  101. // and variable translation for the rest. All others are variable
  102. //
  103. M =   SCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
  104. M=M + SCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
  105. N=    SCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
  106. N=N + SCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
  107. REPLACE CLINOM     WITH M,;
  108.         CLIVILLE   WITH N,;
  109.         CLIRUE     WITH SCRAMBLE (CLIRUE,     M_VAR),;
  110.         CLIADS     WITH SCRAMBLE (CLIADS,     M_VAR),;
  111.         CLISIRET   WITH SCRAMBLE (CLISIRET,   M_VAR),;
  112.         CLICONTACT WITH SCRAMBLE (CLICONTACT, M_VAR),;
  113.         CLICONTAC2 WITH SCRAMBLE (CLICONTAC2, M_VAR)
  114.  
  115. REPLACE CLIPHONE  WITH SCRAMBLE (CLIPHONE,  M_VAR),;
  116.         CLIPHONED WITH SCRAMBLE (CLIPHONED, M_VAR),;
  117.         CLIPHONEV WITH SCRAMBLE (CLIPHONEV, M_VAR),;
  118.         CLIFAX    WITH SCRAMBLE (CLIFAX,    M_VAR),;
  119.         CLIBNCPT  WITH SCRAMBLE (CLIBNCPT,  M_VAR),;
  120.         CNTRL     WITH SCRAMBLE (CNTRL,     M_VAR),;
  121.         CLISCRAMBL WITH .T.
  122. RETURN .T.
  123. //
  124. //
  125. //-------------------------------------------------------------------------
  126. //
  127. // Function unscrambles a CLIENT record
  128. //
  129. FUNCTION UNSCRAM_CLI (SEED)
  130. //
  131. LOCAL M_FIX:= RANDOM (SEED, 5, 31)   // Generate 5 random n°s between 1 and 31
  132. LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31)    // 30 codes.
  133. LOCAL M, N
  134. //
  135. // See comments on SCRAM_CLI
  136. //
  137. IF .NOT. CLISCRAMBL
  138.    RETURN .T.        // Already unscrambled
  139. ENDIF
  140. M =   UNSCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
  141. M=M + UNSCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
  142. N=    UNSCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
  143. N=N + UNSCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
  144.  
  145. REPLACE CLINOM     WITH M,;
  146.         CLIVILLE   WITH N,;
  147.         CLIRUE     WITH UNSCRAMBLE (CLIRUE,     M_VAR),;
  148.         CLIADS     WITH UNSCRAMBLE (CLIADS,     M_VAR),;
  149.         CLISIRET   WITH UNSCRAMBLE (CLISIRET,   M_VAR),;
  150.         CLICONTACT WITH UNSCRAMBLE (CLICONTACT, M_VAR),;
  151.         CLICONTAC2 WITH UNSCRAMBLE (CLICONTAC2, M_VAR)
  152.  
  153. REPLACE CLIPHONE   WITH UNSCRAMBLE (CLIPHONE,  M_VAR),;
  154.         CLIPHONED  WITH UNSCRAMBLE (CLIPHONED, M_VAR),;
  155.         CLIPHONEV  WITH UNSCRAMBLE (CLIPHONEV, M_VAR),;
  156.         CLIFAX     WITH UNSCRAMBLE (CLIFAX,    M_VAR),;
  157.         CLIBNCPT   WITH UNSCRAMBLE (CLIBNCPT,  M_VAR),;
  158.         CNTRL      WITH UNSCRAMBLE (CNTRL,     M_VAR),;
  159.         CLISCRAMBL WITH .F.
  160. RETURN .T.
  161. //
  162. //
  163. //-------------------------------------------------------------------------
  164. //
  165. // Function creates a seed from a fixed seed (1000 - 9999) and RECNO()
  166. //
  167. FUNCTION REC_SEED (SEED)
  168. //
  169. IF SEED >= 0                  // If not, it is the SERVER - leave alone
  170.    SEED = RECNO() * 10000 + SEED
  171.    DO WHILE SEED > 9999
  172.       SEED = SEED / 7         // Largest prime under 10
  173.    ENDDO
  174. ENDIF
  175. RETURN SEED
  176. //
  177. //-------------------------------------------------------------------------
  178. //
  179. // Function scrambles a string
  180. //
  181. // Each character of R_STRING (a series of random numbers between 1 and 31) is
  182. // added to its equivalent character in A_STRING so as to scramble it
  183. //
  184. FUNCTION SCRAMBLE (A_String, R_String)
  185. //
  186. LOCAL I,Ans:=""
  187. //
  188. IF LEN(A_String) > 0
  189.    FOR I=1 TO LEN (A_String)
  190.       Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))+ASC(SUBSTR(R_String,I,1)))
  191.    NEXT
  192. ENDIF
  193. RETURN Ans
  194. //
  195. //
  196. //-------------------------------------------------------------------------
  197. //
  198. // Function unscrambles a string
  199. //
  200. // Each character of R_STRING (a series of random numbers between 1 and 31) is
  201. // subtracted from its equivalent character in A_STRING so as to unscramble it
  202. //
  203. FUNCTION UNSCRAMBLE (A_String, R_String)
  204. //
  205. LOCAL I,Ans:=""
  206.  
  207. IF LEN(A_String) > 0
  208.    FOR I=1 TO LEN (A_STRING)
  209.       Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))-ASC(SUBSTR(R_String,I,1)))
  210.    NEXT
  211. ENDIF
  212. RETURN Ans
  213. //
  214. //-------------------------------------------------------------------------
  215. //
  216. // Function generates an string full of random characters
  217. //
  218. // PARAMETERS: SEED  = a 4 digit number used to seed the generator
  219. //             No    = the number of random characters required
  220. //             Max   = the maximum character value
  221. //                     i.e. each character is between 1 and Max inclusive
  222. //
  223. //     Returns Ans   = A string of length No containing the random chacters
  224. //
  225. FUNCTION RANDOM (SEED, No, Max)
  226. //
  227. LOCAL Ans:="", IC, MF, MC, MS
  228.  
  229. IF SEED < 0                 // No Coding required
  230.    RETURN REPLICATE(CHR(0),No)
  231. ENDIF
  232.  
  233. FOR IC = 1 TO No
  234.  
  235.    // Make sure that the seed does not have an exact square root !!!
  236.    //
  237.    DO WHILE .T.
  238.       MS=SQRT (SEED)
  239.       MS=(MS * 10000 - INT(MS * 10000)) // Take off 1st 4 digits of fraction
  240.       IF MS <> 0                        // There is still a fractional part
  241.          EXIT                           // so it is O.K.
  242.       ENDIF
  243.       SEED = SEED+1                     // Try the next integer up
  244.    ENDDO
  245.  
  246.    MF = SQRT(SEED)-INT(SQRT(SEED))      // Fractional part of square root
  247.    MC = INT( MF * Max )                 // Range is 0 to Max-1
  248.    Ans = Ans + CHR(MC+1)                // Add to answer string
  249.    SEED = INT(MF * 10000)               // New seed (4 digits)
  250.  
  251. NEXT
  252. RETURN Ans
  253. //
  254. //-------------------------------------------------------------------------
  255. //
  256. FUNCTION SPEEDO(MRow,Mlong)
  257. *
  258. LOCAL MPos
  259. @ MRow, 79*RECNO()/Mlong SAY "░"
  260. RETURN .T.
  261. //
  262. //-------------------------------------------------------------------------
  263. //
  264. FUNCTION READ_SEED (MROW,MCOL, MT, M_Reg)
  265.  
  266. // The equivalent of PASSWD()
  267. // Requires a GLOBAL variable M_Control containing the 6 character
  268. // control field from ATTACH->PCON
  269.  
  270.  
  271. LOCAL MPW, I:=0, C
  272. *
  273. DO HLOFF WITH LCD
  274. CLEAR
  275.  
  276. @ 2,40-LEN(MT)/2 SAY MT
  277. @ 1,40-LEN(MT)/2-2 TO 3,40+LEN(MT)/2+2 DOUBLE
  278. IF PCOUNT() > 3
  279.    @ 5,5 SAY "NUMERO VRP   : "+M_Reg
  280. ENDIF
  281.  
  282. @ 23,75 SAY "V9.1"
  283.  
  284. DO WHILE I < 3
  285.  
  286.  
  287.    CLEAR TYPEAHEAD
  288.    MPW=""
  289.    @ MROW,0 CLEAR TO MROW,79
  290.    @ MROW,MCOL SAY "MOT DE PASSE ? "
  291.    //
  292.    // DO Reads in the user's attempt at the password
  293.    //
  294.    DO WHILE .T.
  295.       C=INKEY(0)
  296.       DO CASE
  297.       CASE C=13
  298.          EXIT
  299.       CASE C>31.AND.C<127
  300.          @ ROW(),COL() SAY "*"
  301.          MPW=MPW+CHR(C)
  302.       CASE (C=8.OR.C=19).AND.LEN(MPW)>0    && Backspace or left arrow
  303.          @ROW(),COL()-1 SAY " "
  304.          @ROW(),COL()-1 SAY ""
  305.          MPW=SUBSTR(MPW,1,LEN(MPW)-1)
  306.       ENDCASE
  307.    ENDDO
  308.    //
  309.  
  310.    IF M_Control == RANDOM(VAL(MPW),6,31)
  311.       RETURN MPW  // Password is O.K.
  312.    ENDIF
  313.  
  314.    I=I+1
  315. ENDDO
  316.  
  317. ALARM ("ACCES INTERDIT")
  318. QUIT
  319. RETURN 0
  320. *
  321.  
  322.