5 REM   *******************************************************************
10 REM  * CRYPTP.BAS - by David Hutchison - March 1983                    *
20 REM  *                                                                 *
30 REM  * This is a unsophisticated example of password protection on a   *
40 REM  * random access file. Note that the first field the employee name *
50 REM  * in not encoded so that unencoded selection can be done on this  *
55 REM  * field. Also note that the password is not checked for validity. *
60 REM  * The existence of the correct password within the program body   *
70 REM  * would not be secure. Data, once encoded, will be irretrievably  *
80 REM  * lost if the password is forgotten. The sample data is encoded   *
90 REM  * using the password FISH. Note that the empty file must be set   *
95 REM  * up with each employee name beginning with '[[[' for this        *
96 REM  * program to function correctly.                                  *
100 REM *******************************************************************
110 REM
200 significance 11 : REM in this example significance 9 is the minimum
205 REM EMPLOYEE is an unformatted variable of length 37
210 map1 EMPLOYEE
220     map2 NAME,s,30
230     map2 SOC'SEC,f,6
240     map2 SEX,s,1
245 REM ENCRYPT could be length 37 in this example or length 7 if @EMPLOYEE
246 REM were changed to @SOC'SEC i.e. MAP1 ENCRYPT(7),b,1,,@SOC'SEC
247 REM the loop I = 31 to len(EMPLOYEE) changed to
248 REM I = 1 to len(EMPLOYEE)-30 and asc(mid$(EMPLOYEE,I,1) changed to
249 REM asc(mid$(EMPLOYEE,I+30,1))
250 map1 ENCRYPT(100),b,1,,@EMPLOYEE
260 map1 PASSW,s,8 : REM you set the maximum length of the password
270 map1 KEY,s,30
275 map1 ERRORCODE,b,1
276 map1 SOC'STR,s,9
280 open #1,"CRYPTP.DAT",random,37,FILE1 : REM open the data file
290 input "Password ";PASSW
293 REM Fix it so that the password can be entered in either upper
294 REM or lower case
295 PASSW = ucs(PASSW)
299 REM Special error handling of subroutines is disabled
300 on error goto 0
305 print TAB(-1,0);
310 print TAB(10,1);"Do you wish to:"
320 print TAB(12,1);"1) Find a record";
330 print TAB(13,1);"2) Add a record";
335 print TAB(14,1);"3) Display all Records";
340 print TAB(15,1);"4) Quit";
350 print TAB(17,1);
360 ANS = 0
370 input "Select One ";ANS
380 if ANS = 4 goto 500
390 on ANS gosub 1000,2000,5000
400 goto 300
500 close #1
510 end
1000 REM
1003 REM *********************************************************
1005 REM * This routine displays the record if found, or returns *
1020 REM *********************************************************
1021 REM
1040 print TAB(-1,0);TAB(10,1);
1050 KEY = ""
1060 input "Employee name ";KEY
1070 gosub 6000
1080 if ERRORCODE = 2 then return
1085 if ERRORCODE = 1 THEN goto 1400
1100 gosub 3000 : REM decrypt the record
1110 print TAB(-1,0);TAB(10,1);"  Employee Name = ";NAME
1120 print "Social Security = ";
1121 SOC'STR = val(SOC'SEC) using "#ZZZZZZZZ"
1122 print left$(SOC'STR,3);"-";
1122 print mid$(SOC'STR,4,2);"-";
1123 print right$(SOC'STR,4)
1130 print "            Sex = ";
1140 if SEX = "M" then print "Male" : goto 1200
1150 if SEX = "F" then print "Female" : goto 1200
1160 print "Unknown"
1200 print TAB(14,1)
1210 print "1) Delete this record?"
1220 print "2) Modify this record?"
1230 print "   RETURN to continue"
1240 ANS = 0
1250 print TAB(18,1);
1260 input "Select one ";ANS
1270 if ANS = 2 print TAB(14,1);TAB(-1,10) : gosub 2070 : goto 1100
1280 if ANS # 1 then return
1290 NAME = "[[["
1300 SOC'SEC = 0
1310 SEX = "["
1320 write #1,EMPLOYEE
1350 return
1400 print TAB(-1,0);TAB(10,1);"Record not found - Name ";KEY
1410 for I = 1 to 2000 : next I
1420 return
2000
2005 REM ************************************************
2010 REM * This routine allows the user to add a record *
2020 REM ************************************************
2021 REM
2025 REM Empty record begins with '[[['
2030 KEY = "[[["
2035 gosub 6000 : REM go find an empty record
2040 if ERRORCODE = 1 then goto 2300 : REM no empty records found
2050 REM input new record
2060 print TAB(-1,0);TAB(10,1)
2070 input "Name = ";NAME
2075 REM Social security is added as a nine-digit number with
2076 REM no dashes, commas, slashes, etc.
2080 input "Social Security = ";SOC'SEC
2090 input "Sex = ";SEX
2091 SEX = ucs(SEX)
2095 gosub 4000 : REM encrypt the record and write to file
2100 write #1,EMPLOYEE
2110 return
2300 REM tell the user when the file is full up
2310 print TAB(-1,0);TAB(10,1);"File Full"
2320 for I = 1 to 2000 : next I
2330 return
3000 REM
3005 REM ******************************
3010 REM * Routine to decrypt records *
3020 REM ******************************
3025 REM
3029 J = FILE1 - (fix(FILE1/len(PASSW)) * len(PASSW))
3030 for I = 31 to len(EMPLOYEE)
3040 J = J + 1
3050 if J > len(PASSW) then J = 1
3060 ENCRYPT(I) = asc(mid$(EMPLOYEE,I,1)) + asc(mid$(PASSW,J,1))
3070 next I
3080 return
4000 REM
4000 REM ******************************
4010 REM * Routine to encrypt records *
4020 REM ******************************
4025 REM
4029 J = FILE1 - (fix(FILE1/len(PASSW)) * len(PASSW))
4030 for I = 31 to len(EMPLOYEE)
4040 J = J + 1
4050 if J > len(PASSW) then J = 1
4060 ENCRYPT(I) = asc(mid$(EMPLOYEE,I,1)) - asc(mid$(PASSW,J,1))
4070 next I
4080 return
5000 REM
5010 REM **********************************************
5020 REM * Routine to display all records in the file *
5030 REM **********************************************
5040 REM
5050 on error goto 5300
5060 FILE1 = 0
5070 read #1,EMPLOYEE
5090 if left$(NAME,3) = "[[[" then goto 5225
5095 gosub 3000
5100 print TAB(-1,0);TAB(10,1);"  Employee Name = ";NAME
5110 print "Social Security = ";
5120 SOC'STR = val(SOC'SEC) using "#ZZZZZZZZ"
5130 print left$(SOC'STR,3);"-";
5140 print mid$(SOC'STR,4,2);"-";
5145 print right$(SOC'STR,4)
5150 print "            Sex = ";
5160 if SEX = "M" then print "Male" : goto 5190
5170 if SEX = "F" then print "Female" : goto 5190
5180 print "Unknown"
5190 print TAB(14,1);TAB(7);
5200 ANS$ = ""
5210 input "Type RETURN to Continue or 'S' to stop ";ANS$
5220 if ANS$ = "S" or ANS$ = "s" then return
5225 FILE1 = FILE1 + 1
5230 goto 5070
5300 if ERR(0) = 31 then goto 5400
5310 print TAB(-1,0);TAB(10,1);"Error Code ";ERR(0)
5320 for I = 1 to 2000 : next I
5330 goto 500 : REM end program
5400 print TAB(-1,0);TAB(10,1);"No more records"
5410 resume 5420
5420 for I = 1 to 2000 : next I
5420 return
6000 REM
6010 REM *********************************************
6020 REM * Simple search routine - You can do better *
6030 REM *********************************************
6040 REM
6050 on error goto 6200
6055 if KEY = "" then ERRORCODE = 2 : goto 6330
6060 ERRORCODE = 0
6070 FILE1 = 0
6075 K = len(KEY)
6080 read #1,EMPLOYEE
6090 if ucs(KEY) = ucs(left$(NAME,K)) then on error goto 0 : return
6100 FILE1 = FILE1 + 1
6110 goto 6080
6200 if ERR(0) = 31 then goto 6300
6210 print TAB(-1,0);TAB(10,1);"Error Code ";ERR(0)
6220 for I = 1 to 2000 : next I
6230 goto 500 : REM end program
6300 ERRORCODE = 1
6310 resume 6320
6320 on error goto 0
6330 return
!========================================================================
! NEEDED FOR CRYPTP.BAS
MAP1 EMP
       MAP2 NAME,S,30,"[[[[[[[[[[[[[[[[[[[[[[[[[[[[[["
       MAP2 SOC,F,6,0
       MAP2 SEX,S,1,"["
on error goto END'IT
allocate "cryptp.dat",1
open #1,"CRYPTP.DAT",random,37,FILE1
FILE1 = 0
LOOP:
print "loop"
write #1,EMP
FILE1 = FILE1 + 1
goto LOOP
END'IT:
print "err(0) = ";ERR(0)
close #1
end

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.