Listing of file='KFAM2003' on disk='vmedia/701-2049C.wvd.zip'
# Sector 191, program filename = 'KFAM2003' 0001 REM KFAM2003,VER.02/18/76 0002 GOTO 3072 0012 COM Q6$64 3072 LOAD DC T#0,"KFAM0003"3072,3072 4800 DIM C$40,U1$8,U0$3,K1$8,K0$3,D8$21,X$64,M$(1)30 : DIM K2$30,B$1,Y$1,D$(4)64,K$30 : D8$="310320330350B10B20B30" : PRINT HEX(03) 5010 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8) : U1$=Q6$ : IF STR(U1$,5,1)<>"F"THEN 5060 : IF STR(U1$,6,1)<"0"THEN 5060 : IF STR(U1$,6,1)<="9"THEN 5090 5060 GOSUB '50("NOT KFAM FILE NAME") : GOTO 5010 5090 GOSUB '125("ENTER THE NO. OF THE USER FILE DEVICE ADDRESS") : D2=X : U0$=STR(D8$,X*3-2,3) : ON D2-1GOTO 5143,5146,5149,5152,5155,5158 : SELECT #2310 : GOTO 5190 5143 SELECT #2320 : GOTO 5190 5146 SELECT #2330 : GOTO 5190 5149 SELECT #2350 : GOTO 5190 5152 SELECT #2B10 : GOTO 5190 5155 SELECT #2B20 : GOTO 5190 5158 SELECT #2B30 5190 GOSUB '245("ENTER KEY FILE NUMBER (NORMAL=1)",1,0) : K9=Q9 : IF K9>0THEN 5240 : GOSUB '50("INVALID") : GOTO 5190 5240 K1$=U1$ : STR(K1$,5,1)="K" : CONVERT K9TO STR(K1$,6,1),(#) : GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS") : D1=X : K0$=STR(D8$,X*3-2,3) : ON D1-1GOTO 5333,5336,5339,5342,5345,5348 : SELECT #1310 : GOTO 5380 5333 SELECT #1320 : GOTO 5380 5336 SELECT #1330 : GOTO 5380 5339 SELECT #1350 : GOTO 5380 5342 SELECT #1B10 : GOTO 5380 5345 SELECT #1B20 : GOTO 5380 5348 SELECT #1B30 5380 GOSUB '243("ENTER LAST KEY",30) : K2$=Q6$ : GOSUB '248(0,0,4) 5396 PRINT "TURN ON PRINTER" : GOSUB '243("KEY RETURN(EXEC) TO RESUME",2) : GOSUB '248(0,0,4) 5402 D=0 : GOSUB '230(1,1,2,K9,U1$) : IF Q$=" "THEN 5450 : STOP "ERROR OPENING FILES" 5450 LIMITS T#2,U1$,A,X,Y : S8=A : E=A+Y : PRINT HEX(03) : GOSUB '248(7,0,0) : PRINT "KFAM2003 KEY FILE CREATION UTILITY" : PRINT HEX(0A) : PRINT "USER FILE ";U1$;TAB(30);"DEVICE = ";U0$ : PRINT "KEY FILE ";K1$;TAB(30);"DEVICE = ";K0$ 5540 %SECTOR ##### RECORD NUMBER ###### 5550 %KEY ################################ 5580 IF Q2$<HEX(FF00)THEN 5600 : IF V5$=V8$THEN 5610 5600 GOSUB '51("KEY FILE NOT INITIALIZED") 5610 S9=VAL(V6$) : R,I=VAL(STR(V1$,2)) : B=VAL(V8$) : K0=VAL(STR(V1$,3))*256+VAL(STR(V1$,4))+1 : K=VAL(STR(V1$,5)) : T5$,K$=" " : S2=0 : B$=STR(V1$,1) : IF B$="A"THEN 6410 : IF B$="C"THEN 5760 : S2=INT((K0-1)/256) : S8=A+S2 : K0=K0-256*S2 5760 B1=B 5770 B1=B1+1 : P1=P1+I : IF B1<=BTHEN 5870 : IF S8<ETHEN 5820 : GOSUB '51("LAST KEY NOT FOUND") 5820 DATA LOAD BA T#2,(S8,X)D$() : S8=S8+S9 : B1=1 : P1=K0 5870 MAT COPY D$()<P1,K>TO M$() : K$=M$(1) : Y$=K$ : IF Y$<HEX(FF)THEN 6130 : ADD(V5$,01) : IF V5$<=V8$THEN 6080 : ADDC(Q2$,V6$) : V5$=HEX(01) 6080 PRINT HEX(010A0A0A0A) : PRINTUSING 5540,S8-A-S9-S2,B1 : PRINTUSING 5550,"DELETED" : GOTO 5770 6130 GOSUB '233(1,0,K$,Q) : IF Q$="X"THEN 6240 : IF Q$="S"THEN 6260 : PRINT HEX(010A0A0A0A) : PRINTUSING 5540,S8-A-S9-S2,B1 : PRINTUSING 5550,K$ : IF Q$="D"THEN 6960 : IF K$<>K2$THEN 5770 6194 SELECT PRINT 215 6196 IF D>0THEN 6200 : PRINT "NO DUPLICATE KEYS" 6200 PRINT HEX(0C) : SELECT PRINT 005 : V8=.5 : GOSUB '239(1) : PRINT HEX(03) : COM CLEAR Q6$ : LOAD DC T#0,"START050" 6240 GOSUB '51("PROGRAM ERROR") 6260 GOSUB '51("NO SPACE") 6290 DEFFN'50(Q6$) : PRINT HEX(010A0A0A) : PRINT Q6$ : RETURN 6350 DEFFN'51(Q6$) : PRINT HEX(01) : PRINT Q6$ : STOP 6410 DATA LOAD BA T#2,(S8,X)D$() : IF STR(D$(1),1,2)=HEX(8101)THEN 6440 6430 GOSUB '51("INVALID RECORD FORMAT") 6440 N=0 : P=3 : C=0 6470 X=INT((P-1)/64) : Y=P-64*X : X=X+1 : Y$=STR(D$(X),Y,1) : IF Y$=HEX(FD)THEN 6680 : IF Y$=HEX(08)THEN 6550 : IF Y$<HEX(81)THEN 6430 : IF Y$>HEX(C0)THEN 6430 6550 IF C=0THEN 6580 : IF Y$=STR(C$,N,1)THEN 6610 6570 GOSUB '51("NOT BLOCKED AS SPECIFIED") 6580 N=N+1 : IF N>38THEN 6430 : STR(C$,N,1)=Y$ 6610 C=C+1 : AND (Y$,7F) : P=P+1+VAL(Y$) : IF C<BTHEN 6470 : C=0 : GOTO 6470 6680 IF C>0THEN 6570 : X=(P-3)/B : IF X=RTHEN 6720 : GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY") 6720 IF N=0THEN 6430 : P=3 : N1=0 6770 N1=N1+1 : IF N1>NTHEN 6870 : Y$=STR(C$,N1,1) : AND (Y$,7F) : Y=VAL(Y$)+1 : IF P+Y>=K0THEN 6860 : P=P+Y : GOTO 6770 6860 IF K0+K<=P+YTHEN 6880 6870 GOSUB '51("KEY FIELD OUT OF BOUNDS") 6880 IF STR(C$,N1,1)>HEX(80)THEN 6910 : GOSUB '51("NUMERIC KEY INVALID") 6910 K0=(P-3)*B+3+K0-P : I=Y : GOTO 5760 6960 SELECT PRINT 215 : PRINT "DUPLICATE KEY IGNORED" : PRINTUSING 5550,K$ : ADD(V5$,01) : IF V5$<=V8$THEN 7040 : ADDC(Q2$,V6$) : V5$=HEX(01) 7040 X=VAL(V5$) : Y=VAL(Q2$)*256+VAL(STR(Q2$,2)) : PRINTUSING 5540,Y,X : PRINT "T4$ (HEX) = "; : HEXPRINT Q2$;V5$ : D=D+1 7100 PRINT HEX(0A0A) : SELECT PRINT 005 : GOTO 5770 7170 DEFFN'125(X$) : GOSUB '248(5,0,5) : PRINT ,"1. 310 5. B10" : PRINT ,"2. 320 6. B20" : PRINT ,"3. 330 7. B30" : PRINT ,"4. 350" 7230 GOSUB '245(X$,1,0) : X=Q9 : IF X<1THEN 7290 : IF X>7THEN 7290 : GOSUB '248(5,0,5) : RETURN 7290 PRINT HEX(010A0A0A) : PRINT "INVALID DEVICE ADDRESS" : GOTO 7230 8710 Q6=3 : GOTO 9289 8975 DEFFN'242(W0,Q6$) : IF W0<=0THEN 9405 : IF W0=1THEN 8990 : STR(Q6$,2)=STR(Q6$,1,W0-1) 8990 PRINT Q6$; : RETURN 9010 DEFFN'243(Q6$,Q0) : GOSUB 9200 9022 SELECT CO 205 : Q6$=" " : INPUT Q6$ : IF Q0=0THEN 9231 : IF Q0>1THEN 9025 : IF Q6$="Y"THEN 9025 : IF Q6$<>"N"THEN 9027 9025 IF LEN(Q6$)<=Q0THEN 9231 9027 GOSUB 9150 9032 DEFFN'244(Q0) : GOSUB 9220 : GOSUB 9210 : GOTO 9022 9038 DEFFN'245(Q6$,Q2,Q3) : Q0=ABS(Q2)+Q3+1 : GOSUB 9200 9044 GOSUB '242(ABS(Q2)+2,HEX(09)) : PRINT "/" : GOSUB 9220 : SELECT CO 205 : Q9,W0=-1E-99 : INPUT Q9 : IF W0=Q9THEN 9058 : IF Q9>=0THEN 9070 : IF Q2<=0THEN 9070 9058 GOSUB 9150 9060 DEFFN'246(Q2,Q3) : Q0=ABS(Q2)+Q3+1 : GOSUB 9220 : GOSUB 9210 : GOTO 9044 9070 IF ABS(Q9)>=10^ABS(Q2)THEN 9058 : W0=ABS(Q9*10^Q3) : IF INT(W0)<>W0THEN 9058 : GOTO 8710 9150 GOSUB 8710 : PRINT "RE-ENTER" : RETURN 9200 GOSUB 9405 : PRINT HEX(010A);STR(Q6$,1); 9210 GOSUB 9405 : GOSUB '242(Q0+2,"-") : PRINT TAB(64) 9220 PRINT HEX(010A0A) : RETURN 9231 PRINT HEX(0A);TAB(64) : GOTO 9405 : Q6=0 9289 Q7=0 : Q8=1 9290 DEFFN'248(Q6,Q7,Q8) : GOSUB 9405 : IF Q8<1THEN 9350 : GOSUB 9350 : SELECT PRINT 205 : Q6$=" " : PRINT STR(Q6$,Q7+1) : IF Q8<2THEN 9350 : FOR W0=2TO Q8 : PRINT HEX(0A);STR(Q6$,1) : NEXT W0 9350 PRINT HEX(01) : GOSUB '242(Q7,HEX(09)) : GOSUB '242(Q6,HEX(0A)) 9405 SELECT PRINT 005(64),CO 005 : RETURN