home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
mail.altrad.com
/
2015.02.mail.altrad.com.tar
/
mail.altrad.com
/
TEST
/
COMMERC_72_53OLD
/
commerc
/
PROGSOLD
/
ENCODE.PRG
< prev
next >
Wrap
Text File
|
2014-04-02
|
9KB
|
322 lines
PROCEDURE MAIN (CONTROL) // To scramble or to unscramble !!!
* Auteur...: R M ALCOCK
* Date.....: 26/2/95
* Copyright: (c) 1995, R M ALCOCK, Tous droits réservés
* Notes....: Subroutines to encode data
*
*
#include "Inkey.ch"
#include "Params"
*
LOCAL SEED,C
DEFAULT CONTROL TO "" // Decrypt
*
SET CONFIRM ON
SET DATE FRENCH
SET DELETED ON
SET EXACT ON
SET EXCLUSIVE OFF
SET FIXED OFF
SET SCOREBOARD ON
SET TALK OFF
SET BELL OFF
SET EPOCH TO 1980
PUBLIC LCD:=.T., M_Control
CLOSE DATABASES
SELECT 1
USE ATTACH
M_Control = PCON // Password Control
USE CLIENT EXCLUSIVE
SEED=VAL(READ_SEED(6,5,;
IIF (CONTROL="", "DECRYPTAGE FICHIER", "CODAGE FICHIER")))
@ 6,0 CLEAR
IF CONTROL = ""
// Should be unscramble
GO TOP
COUNT NEXT 10 FOR CLISCRAMBL TO C
IF C < 10 .AND. .NOT. CONFIRM (5,,"N","CONFIRM DECRYPTAGE")
QUIT
ENDIF
//
GO TOP
@ 6,0 SAY "DECRYPTAGE FICHIER"
DO WHILE .NOT. EOF()
SPEEDO (8,RECCOUNT())
UNSCRAM_CLI(SEED)
SKIP
ENDDO
//
ELSE
//
@ 6,0 SAY "CODAGE FICHIER"
DO WHILE .NOT. EOF()
SPEEDO (8,RECCOUNT())
SCRAM_CLI(SEED)
SKIP
ENDDO
ENDIF
?"Indexation REF"
INDEX ON CLIREF TO CLIREF
?"Indexation CODE POSTALE"
INDEX ON CLICP+SUBSTR(CLIVILLE,1,5) TO CLICP
?"Indexation NOM"
INDEX ON CLINOM TO CLINOM
//
//
RETURN
//
//
//-------------------------------------------------------------------------
//
// Function scrambles a CLIENT record
//
FUNCTION SCRAM_CLI (SEED)
//
// SEED is the seed for the random number generator
//
LOCAL M_FIX:= RANDOM (SEED, 5, 31) // Generate 5 random n°s between 1 and 31
LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31) // 30 codes.
LOCAL M,N
//
// M_FIX is used for those variables which are indexed and therefore must
// use the same translation for all
//
// M_VAR increases the degree of randomness because the seed is different
// for each record. Hence the translation is different for the same
// parameters in different records
//
//
IF CLISCRAMBL
RETURN .T. // Already scrambled
ENDIF
//
// Scramble CLINOM and VILLE using fixed translation for the first 5 chars
// and variable translation for the rest. All others are variable
//
M = SCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
M=M + SCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
N= SCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
N=N + SCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
REPLACE CLINOM WITH M,;
CLIVILLE WITH N,;
CLIRUE WITH SCRAMBLE (CLIRUE, M_VAR),;
CLIADS WITH SCRAMBLE (CLIADS, M_VAR),;
CLISIRET WITH SCRAMBLE (CLISIRET, M_VAR),;
CLICONTACT WITH SCRAMBLE (CLICONTACT, M_VAR),;
CLICONTAC2 WITH SCRAMBLE (CLICONTAC2, M_VAR)
REPLACE CLIPHONE WITH SCRAMBLE (CLIPHONE, M_VAR),;
CLIPHONED WITH SCRAMBLE (CLIPHONED, M_VAR),;
CLIPHONEV WITH SCRAMBLE (CLIPHONEV, M_VAR),;
CLIFAX WITH SCRAMBLE (CLIFAX, M_VAR),;
CLIBNCPT WITH SCRAMBLE (CLIBNCPT, M_VAR),;
CNTRL WITH SCRAMBLE (CNTRL, M_VAR),;
CLISCRAMBL WITH .T.
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function unscrambles a CLIENT record
//
FUNCTION UNSCRAM_CLI (SEED)
//
LOCAL M_FIX:= RANDOM (SEED, 5, 31) // Generate 5 random n°s between 1 and 31
LOCAL M_VAR:= RANDOM(REC_SEED (SEED), 30, 31) // 30 codes.
LOCAL M, N
//
// See comments on SCRAM_CLI
//
IF .NOT. CLISCRAMBL
RETURN .T. // Already unscrambled
ENDIF
M = UNSCRAMBLE (SUBSTR(CLINOM,1,5), M_FIX)
M=M + UNSCRAMBLE (SUBSTR(CLINOM, 6, LEN(CLINOM)-5), M_VAR)
N= UNSCRAMBLE (SUBSTR(CLIVILLE, 1, 5), M_FIX)
N=N + UNSCRAMBLE (SUBSTR(CLIVILLE, 6, LEN(CLIVILLE)-5), M_VAR)
REPLACE CLINOM WITH M,;
CLIVILLE WITH N,;
CLIRUE WITH UNSCRAMBLE (CLIRUE, M_VAR),;
CLIADS WITH UNSCRAMBLE (CLIADS, M_VAR),;
CLISIRET WITH UNSCRAMBLE (CLISIRET, M_VAR),;
CLICONTACT WITH UNSCRAMBLE (CLICONTACT, M_VAR),;
CLICONTAC2 WITH UNSCRAMBLE (CLICONTAC2, M_VAR)
REPLACE CLIPHONE WITH UNSCRAMBLE (CLIPHONE, M_VAR),;
CLIPHONED WITH UNSCRAMBLE (CLIPHONED, M_VAR),;
CLIPHONEV WITH UNSCRAMBLE (CLIPHONEV, M_VAR),;
CLIFAX WITH UNSCRAMBLE (CLIFAX, M_VAR),;
CLIBNCPT WITH UNSCRAMBLE (CLIBNCPT, M_VAR),;
CNTRL WITH UNSCRAMBLE (CNTRL, M_VAR),;
CLISCRAMBL WITH .F.
RETURN .T.
//
//
//-------------------------------------------------------------------------
//
// Function creates a seed from a fixed seed (1000 - 9999) and RECNO()
//
FUNCTION REC_SEED (SEED)
//
IF SEED >= 0 // If not, it is the SERVER - leave alone
SEED = RECNO() * 10000 + SEED
DO WHILE SEED > 9999
SEED = SEED / 7 // Largest prime under 10
ENDDO
ENDIF
RETURN SEED
//
//-------------------------------------------------------------------------
//
// Function scrambles a string
//
// Each character of R_STRING (a series of random numbers between 1 and 31) is
// added to its equivalent character in A_STRING so as to scramble it
//
FUNCTION SCRAMBLE (A_String, R_String)
//
LOCAL I,Ans:=""
//
IF LEN(A_String) > 0
FOR I=1 TO LEN (A_String)
Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))+ASC(SUBSTR(R_String,I,1)))
NEXT
ENDIF
RETURN Ans
//
//
//-------------------------------------------------------------------------
//
// Function unscrambles a string
//
// Each character of R_STRING (a series of random numbers between 1 and 31) is
// subtracted from its equivalent character in A_STRING so as to unscramble it
//
FUNCTION UNSCRAMBLE (A_String, R_String)
//
LOCAL I,Ans:=""
IF LEN(A_String) > 0
FOR I=1 TO LEN (A_STRING)
Ans=Ans+CHR(ASC(SUBSTR(A_String,I,1))-ASC(SUBSTR(R_String,I,1)))
NEXT
ENDIF
RETURN Ans
//
//-------------------------------------------------------------------------
//
// Function generates an string full of random characters
//
// PARAMETERS: SEED = a 4 digit number used to seed the generator
// No = the number of random characters required
// Max = the maximum character value
// i.e. each character is between 1 and Max inclusive
//
// Returns Ans = A string of length No containing the random chacters
//
FUNCTION RANDOM (SEED, No, Max)
//
LOCAL Ans:="", IC, MF, MC, MS
IF SEED < 0 // No Coding required
RETURN REPLICATE(CHR(0),No)
ENDIF
FOR IC = 1 TO No
// Make sure that the seed does not have an exact square root !!!
//
DO WHILE .T.
MS=SQRT (SEED)
MS=(MS * 10000 - INT(MS * 10000)) // Take off 1st 4 digits of fraction
IF MS <> 0 // There is still a fractional part
EXIT // so it is O.K.
ENDIF
SEED = SEED+1 // Try the next integer up
ENDDO
MF = SQRT(SEED)-INT(SQRT(SEED)) // Fractional part of square root
MC = INT( MF * Max ) // Range is 0 to Max-1
Ans = Ans + CHR(MC+1) // Add to answer string
SEED = INT(MF * 10000) // New seed (4 digits)
NEXT
RETURN Ans
//
//-------------------------------------------------------------------------
//
FUNCTION SPEEDO(MRow,Mlong)
*
LOCAL MPos
@ MRow, 79*RECNO()/Mlong SAY "░"
RETURN .T.
//
//-------------------------------------------------------------------------
//
FUNCTION READ_SEED (MROW,MCOL, MT, M_Reg)
// The equivalent of PASSWD()
// Requires a GLOBAL variable M_Control containing the 6 character
// control field from ATTACH->PCON
LOCAL MPW, I:=0, C
*
DO HLOFF WITH LCD
CLEAR
@ 2,40-LEN(MT)/2 SAY MT
@ 1,40-LEN(MT)/2-2 TO 3,40+LEN(MT)/2+2 DOUBLE
IF PCOUNT() > 3
@ 5,5 SAY "NUMERO VRP : "+M_Reg
ENDIF
@ 23,75 SAY "V9.1"
DO WHILE I < 3
CLEAR TYPEAHEAD
MPW=""
@ MROW,0 CLEAR TO MROW,79
@ MROW,MCOL SAY "MOT DE PASSE ? "
//
// DO Reads in the user's attempt at the password
//
DO WHILE .T.
C=INKEY(0)
DO CASE
CASE C=13
EXIT
CASE C>31.AND.C<127
@ ROW(),COL() SAY "*"
MPW=MPW+CHR(C)
CASE (C=8.OR.C=19).AND.LEN(MPW)>0 && Backspace or left arrow
@ROW(),COL()-1 SAY " "
@ROW(),COL()-1 SAY ""
MPW=SUBSTR(MPW,1,LEN(MPW)-1)
ENDCASE
ENDDO
//
IF M_Control == RANDOM(VAL(MPW),6,31)
RETURN MPW // Password is O.K.
ENDIF
I=I+1
ENDDO
ALARM ("ACCES INTERDIT")
QUIT
RETURN 0
*