Listing of file='KFAM9004' on disk='vmedia/701-2086B.wvd.zip'
# Sector 423, program filename = 'KFAM9004' 0001 REM KFAM9004,VER.03/02/76 0002 GOTO 3072 0012 COM Q6$64 0240 DIM T3$(1)33,V9(3),Q0$(4)60,V5$(4)1,V2$(4)2,T8$(4)1,V4$(4)2,T1$(1)2 0570 STOP 1015 STOP 3072 LOAD DC T#0,"KFAM0004"3072,3072 4800 DIM D8$21,U2$2 : DIM C$40,Y$1,U1$8,U0$3,K1$8,K0$3,E1$6,E4$3,X1$2 : DIM B$1,D$(4)64,K$30,V5$1 : D8$="310320330350B10B20B30" : GOTO 6000 4900 P1=P1+I : ADDC(V5$,01) : IF V5$<=V8$THEN 4970 4920 ADDC(Q2$,V6$) : V9$=U2$ : ADDC(V9$,Q2$) : ADDC(V9$,STR(V1$,3,1)) 4950 DATA LOAD BA T#2,(V9$,V9$)D$() : V5$=HEX(01) : P1=K0 4970 T4$=Q2$ : STR(T4$,3)=V5$ : MAT COPY D$()<P1,K>TO T3$() : Y$,K$=T3$(1) : IF Y$<HEX(FF)THEN 5095 : K$="DELETED" : GOSUB 5035 : GOTO 7245 5035 PRINT HEX(010A0A0A0A) : GOSUB '41(Q2$) : Y=VAL(V5$) : PRINTUSING 7120,X,Y : PRINTUSING 7125,K$ : RETURN 5095 GOSUB '234(1,0,K$,Q) : IF Q$="X"THEN 7300 : IF Q$="S"THEN 7305 : GOSUB 5035 : IF Q$<>"D"THEN 7245 : GOSUB '44(0) : GOTO 7245 6000 PRINT HEX(03) 6005 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8,1) : U1$=Q6$ : IF STR(U1$,5,1)<>"F"THEN 6030 : IF STR(U1$,6,1)<"0"THEN 6030 : IF STR(U1$,6,1)<="9"THEN 6042 6030 GOSUB '50("NOT KFAM FILE NAME") : GOTO 6005 6042 GOSUB '126("USER") : U0$=STR(D8$,X*3-2,3) : ON X-1GOTO 6054,6058,6062,6066,6070,6074 : SELECT #2310 : GOTO 6095 6054 SELECT #2320 : GOTO 6095 6058 SELECT #2330 : GOTO 6095 6062 SELECT #2350 : GOTO 6095 6066 SELECT #2B10 : GOTO 6095 6070 SELECT #2B20 : GOTO 6095 6074 SELECT #2B30 6095 GOSUB '243("ENTER KEY FILE NUMBER (NORMAL=1)",1,2) : K9=Q9 : IF K9>0THEN 6120 : GOSUB '50("INVALID") : GOTO 6095 6120 K1$=U1$ : STR(K1$,5,1)="K" : CONVERT K9TO STR(K1$,6,1),(#) : GOSUB '126("KEY") : K0$=STR(D8$,X*3-2,3) : D1=X : LIMITS T#2,U1$,A,E,U : GOSUB '43(A) : U2$=X1$ : E=E-1 : U=E-A : DATA LOAD BA T#2,(E,Y)D$() : T1$=HEX(A002A002A001A001A008A001A002) 6225 $UNPACK(F=T1$)D$()TO V9$,E4$,V5$(),V8$,V1$,V6$,V2$() : V5$,STR(E4$,3)=V8$ : B=VAL(V8$) : S9=VAL(V6$) : K=VAL(STR(V1$,5)) : V6=VAL(STR(V1$,6)) : B$=V1$ : GOSUB '210(T6) : GOSUB '243("IS KEY FILE CATALOGUED? (Y OR N)",1,0) 6275 IF Q6$<>"N"THEN 6335 : Y=INT((U*B)/S9) : X=INT(V6*.6)-1 : Z=INT(Y/X)+5 6310 DATA SAVE DC OPEN T$#1,Z,K1$ : DSKIP #1,Z-2S : DATA SAVE DC $#1,END : DATA SAVE DC CLOSE#1 6335 LIMITS T#1,K1$,P,Z,X : GOSUB '43(U-1) : Q3$=X1$ : GOSUB '43(S9-1) : Q2$=X1$ : XOR (Q2$,FF) : V2$=HEX(0001) : GOSUB '43(Z-P-2) : V3$=X1$ : T2$=HEX(0001) : T0=1 : INIT(5A)T8$() : Q0$=" " : INIT(FF)V4$ : GOSUB '43(P) : V0$=X1$ : T1=1 : GOSUB 1015 6450 INIT(FF)Q0$() : INIT(00)STR(Q0$(1),1,K) : Q9$=HEX(0001) : GOSUB 570 7010 GOSUB '248(0,0,4) : PRINT "TURN ON PRINTER" : GOSUB '243("KEY RETURN(EXEC) TO RESUME",1,1) 7030 GOSUB '248(0,0,4) : D=0 : GOSUB '230(1,1,2,K9,U1$,"X") : IF Q$=" "THEN 7090 : STOP "ERROR OPENING FILES" : GOTO 7282 7090 PRINT HEX(03) : GOSUB '248(7,0,0) : PRINT "KFAM9004 KEY FILE RECOVERY" : PRINT HEX(0A) : PRINT "USER FILE ";U1$;TAB(30);"DEVICE = ";U0$ : PRINT "KEY FILE ";K1$;TAB(30);"DEVICE = ";K0$ 7120 %SECTOR ##### RECORD NUMBER ###### 7125 %KEY ################################ 7160 R,I=VAL(STR(V1$,2)) : K0=VAL(STR(V1$,4))+1 : T5$,K$=" " : IF E4$>HEX(FF)THEN 7250 : IF B$="A"THEN 7380 7206 INIT(FF)T1$() : FOR X=1TO 4 : Y=VAL(V5$(X))+1 : IF Y>BTHEN 7232 : V9$=U2$ : ADDC(V9$,V2$(X)) : DATA LOAD BA T#2,(V9$,X1$)D$() : FOR Y=YTO B : P1=K0+(Y-1)*I : MAT COPY T1$()TO D$()<P1,1> : NEXT Y : DATA SAVE BA T$#2,(V9$,X1$)D$() 7232 NEXT X : GOTO 4900 7245 IF T4$<E4$THEN 4900 7250 GOSUB '44(2) : V8=.5 : GOSUB '239(1) 7282 PRINT HEX(03) : COM CLEAR Q6$ : LOAD DC T#0,"START065" 7300 GOSUB '51("INVALID POINTER") 7305 GOSUB '51("NO SPACE") 7320 DEFFN'50(Q6$) : PRINT HEX(010A0A0A) : PRINT Q6$ : RETURN 7350 DEFFN'51(Q6$) : RETURN CLEAR 7355 PRINT HEX(01) : PRINT Q6$ 7365 STOP : GOTO 7282 7380 DATA LOAD BA T#2,(U2$,X1$)D$() : IF STR(D$(1),1,2)=HEX(8101)THEN 7395 7390 GOSUB '51("INVALID RECORD FORMAT") 7395 N=0 : P=3 : C=0 7415 X=INT((P-1)/64) : Y=P-64*X : X=X+1 : Y$=STR(D$(X),Y,1) : IF Y$=HEX(FD)THEN 7520 : IF Y$=HEX(08)THEN 7455 : IF Y$<HEX(81)THEN 7390 : IF Y$>HEX(C0)THEN 7390 7455 IF C=0THEN 7470 : IF Y$=STR(C$,N,1)THEN 7485 7465 GOSUB '51("NOT BLOCKED AS SPECIFIED") 7470 N=N+1 : IF N>38THEN 7390 : STR(C$,N,1)=Y$ 7485 C=C+1 : AND (Y$,7F) : P=P+1+VAL(Y$) : IF C<BTHEN 7415 : C=0 : GOTO 7415 7520 IF C>0THEN 7465 : X=(P-3)/B : IF X=RTHEN 7545 : GOSUB '51("RECORD LENGTH NOT SPECIFIED CORRECTLY") 7545 IF N=0THEN 7390 : P=3 : N1=0 7575 N1=N1+1 : IF N1>NTHEN 7630 : Y$=STR(C$,N1,1) : AND (Y$,7F) : Y=VAL(Y$)+1 : IF P+Y>=K0THEN 7625 : P=P+Y : GOTO 7575 7625 IF K0+K<=P+YTHEN 7635 7630 GOSUB '51("KEY FIELD OUT OF BOUNDS") 7635 IF STR(C$,N1,1)>HEX(80)THEN 7650 : GOSUB '51("NUMERIC KEY INVALID") 7650 K0=(P-3)*B+3+K0-P : I=Y : GOTO 7206 7810 ON ERRORE1$,STR(E1$,3)GOTO 7820 7820 IF E1$<>"724950"THEN 7900 : GOSUB '44(1) : IF Q2$<STR(E4$,1,2)THEN 4920 : GOTO 7250 7900 IF E1$<>"796310"THEN 7920 : GOSUB '50("FILE ALREADY CATALOGUED") : GOTO 6095 7920 IF E1$<>"626310"THEN 7940 : GOSUB '248(0,0,4) : GOSUB '51("NO SPACE ON DISK FOR KEY FILE") 7940 IF E1$<>"806335"THEN 7960 : GOSUB '50("FILE NOT FOUND") : GOTO 6095 7960 GOSUB '248(0,0,4) : PRINTUSING 7970,STR(E1$,1,2),STR(E1$,3) 7970 %ERROR ##, LINE #### 7975 GOTO 7365 7985 DEFFN'41(X1$) : X=VAL(X1$)*256+VAL(STR(X1$,2)) : RETURN 8120 DEFFN'43(X) : Y=INT(X/256) : BIN(X1$)=Y : BIN(STR(X1$,2))=X-256*Y : RETURN 8170 DEFFN'126(E1$) : GOSUB '248(5,0,5) : PRINT ,"1. 310 5. B10" : PRINT ,"2. 320 6. B20" : PRINT ,"3. 330 7. B30" : PRINT ,"4. 350" : Q6$="ENTER THE NO. OF THE **** FILE DEVICE ADDRESS" 8197 STR(Q6$,22,4)=E1$ 8200 GOSUB '243(Q6$,1,2) : X=Q9 : IF X<1THEN 8230 : IF X>7THEN 8230 : GOSUB '248(5,0,5) : RETURN 8230 PRINT HEX(010A0A0A) : PRINT "INVALID DEVICE ADDRESS" : GOTO 8200 8275 DEFFN'44(Z) 8285 SELECT PRINT 215 8295 GOSUB '41(Q2$) : ON ZGOTO 8365,8385 : PRINT "DUPLICATE KEY IGNORED" : PRINTUSING 7125,K$ : PRINTUSING 7120,X,VAL(V5$) : PRINT "HEX POINTER (T4$) = "; : HEXPRINT T4$ : D=D+1 8345 PRINT HEX(0A0A) 8350 SELECT PRINT 005 : RETURN 8365 PRINTUSING 8370,X,B 8370 %UNREADABLE SECTOR #####, ### RECORDS LOST 8375 GOTO 8345 8385 IF D>0THEN 8395 : PRINT "NO DUPLICATE KEYS" 8395 PRINT HEX(0C) : GOTO 8350 8430 DEFFN'210(T6) : IF M$="X"THEN 8530 : ON D1GOTO 8445,8455,8465,8475,8485,8495,8505 8445 SELECT #1390 : RETURN 8455 SELECT #13A0 : RETURN 8465 SELECT #13B0 : RETURN 8475 SELECT #13D0 : RETURN 8485 SELECT #1B90 : RETURN 8495 SELECT #1BA0 : RETURN 8505 SELECT #1BB0 : RETURN 8525 DEFFN'211(T6) 8530 ON D1GOTO 8535,8545,8555,8565,8575,8585,8595 8535 SELECT #1310 : RETURN 8545 SELECT #1320 : RETURN 8555 SELECT #1330 : RETURN 8565 SELECT #1350 : RETURN 8575 SELECT #1B10 : RETURN 8585 SELECT #1B20 : RETURN 8595 SELECT #1B30 : RETURN 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,Q2) : GOSUB 9200 9022 SELECT CO 205 : Q6$=" " : INPUT Q6$ : IF Q0=0THEN 9231 : Q3=LEN(Q6$) : IF Q3>Q0THEN 9032 : ON Q2GOTO 9231,9026 : IF Q6$="Y"THEN 9231 : IF Q6$="N"THEN 9231 : GOTO 9032 9026 IF NUM(Q6$)<Q3THEN 9032 : CONVERT Q6$TO Q9 : IF Q9<0THEN 9032 : IF Q9=INT(Q9)THEN 9231 9032 GOSUB 9150 : GOSUB 9220 : GOSUB 9210 : GOTO 9022 9150 GOSUB '248(3,0,1) : 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 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