Listing of file='KFAM5002' on disk='vmedia/701-2049C.wvd.zip'
# Sector 357, program filename = 'KFAM5002'
0001 REM KFAM5002,VER.09/26/75
0002 GOTO 3072
0012 COM Q6$64
3072 LOAD DC T#0,"KFAM0002"3072,3072
4800 DIM C$40,Y$1,U1$8,U0$3,K1$8,K0$3,X$64,D8$21
: DIM B$1,D$(4)64,K$12,K9$12,K4$12,K2$12
: DIM C2$2,S2$1,C3$1,X1$2,C0$2,C4$3,L4$3,S$2
: D8$="310320330350B10B20B30"
5000 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 '60("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 '60("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 5420
5333 SELECT #1320
: GOTO 5420
5336 SELECT #1330
: GOTO 5420
5339 SELECT #1350
: GOTO 5420
5342 SELECT #1B10
: GOTO 5420
5345 SELECT #1B20
: GOTO 5420
5348 SELECT #1B30
5420 GOSUB '230(1,1,2,K9,U1$)
: IF Q$=" "THEN 5450
: STOP "ERROR OPENING FILES"
5450 LIMITS T#2,U1$,A,X,Y
: X=INT(A/256)
: BIN(C0$)=X
: BIN(STR(C0$,2))=A-256*X
: PRINT HEX(030A0A0A0A)
: PRINT "KFAM FILE CONVERSION (KFAM5002)"
: PRINT HEX(0A)
: PRINT "UF NAME = ";U1$;TAB(26);"UF DEVICE = ";U0$
5500 PRINT "KF NAME = ";K1$;TAB(26);"KF DEVICE = ";K0$
: GOSUB '248(0,0,4)
5510 PRINT "TURN ON PRINTER"
: GOSUB '243("KEY RETURN(EXEC) TO RESUME",2)
: GOSUB '248(0,0,4)
: SELECT PRINT 215
: PRINT HEX(0A0A)
: PRINT "KFAM FILE CONVERSION (KFAM5002)"
: PRINT HEX(0A0A)
5545 L=0
: INIT(00)K4$
: 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))
: L4$=Q2$
: STR(L4$,3)=V5$
: R1=0
: D,I1=0
: B$=STR(V1$,1)
: S2$=HEX(00)
: IF B$="A"THEN 6410
: IF B$="C"THEN 5760
: X=INT((K0-1)/256)
5740 BIN(S2$)=X
: K0=K0-256*X
5760 C3$=V8$
: C2$=HEX(00)
: STR(C2$,2)=V6$
: XOR (C2$,FF)
: ADDC(C2$,01)
5800 ADDC(C3$,01)
: P1=P1+I
: IF C3$<=V8$THEN 5860
: ADDC(C2$,V6$)
: S$=C2$
: ADDC(S$,S2$)
: ADDC(S$,C0$)
: DATA LOAD BA T#2,(S$,X1$)D$()
: C3$=HEX(01)
: P1=K0
5860 R1=R1+1
: C4$=C2$
: STR(C4$,3)=C3$
: X1=INT((P1-1)/64)+1
: Y1=P1-64*(X1-1)
: K$=" "
: K$=STR(D$(X1),Y1)
: Z=65-Y1
: IF Z>=KTHEN 5940
: STR(K$,Z+1)=STR(D$(X1+1),1)
5940 IF K=12THEN 5955
: INIT(20)STR(K$,K+1)
5955 GOSUB '232(1,0,K$)
: IF Q$=" "THEN 5980
: IF Q$="X"THEN 6330
: GOTO 6020
5980 IF T4$<>C4$THEN 6020
: K2$=K$
: IF STR(K$,1,K)=STR(K4$,1,K)THEN 6050
: IF STR(K$,1,1)=HEX(FF)THEN 6050
: GOTO 6060
6020 STR(D$(X1),Y1,1)=HEX(FF)
: DATA SAVE BA T$#2,(S$,X1$)D$()
6030 GOSUB '50("DELETED")
: D=D+1
: GOTO 6060
6050 GOSUB '50("INVALID KEY")
: I1=I1+1
6060 IF C4$<L4$THEN 5800
: PRINT HEX(0A0A)
: IF L<42THEN 6092
: PRINT HEX(0C)
6092 PRINTUSING 6094,R1-D-I1
6094 %ACTIVE RECORDS ######
6096 PRINTUSING 6098,D
6098 %DELETED RECORDS ######
6100 PRINTUSING 6102,I1
6102 %INVALID RECORDS ######
6104 PRINTUSING 6106,R1
6106 %TOTAL INPUT ######
6110 PRINT HEX(0A0A)
: PRINTUSING 6120,K2$;
6120 %LAST KEY = ############
6125 PRINT " HEX = ";
: HEXPRINT K2$
: PRINT HEX(0C)
: SELECT PRINT 005
: GOSUB '239(1)
: Q6$="DO YOU WISH TO DO ANOTHER FILE? (Y OR N)"
: GOSUB '243(Q6$,1)
: IF Q6$="Y"THEN 5000
: GOSUB '248(0,0,4)
: COM CLEAR Q6$
: LOAD DC T#0,"START050"
6195 DEFFN'50(Q6$)
6200 IF L>0THEN 6220
: L=5
6210 PRINT "HEX KEY";TAB(26);"KEY SECTOR REC MESSAGE"
: PRINT HEX(0A)
6220 IF L<50THEN 6245
: PRINT HEX(0C)
: L=1
: GOTO 6210
6245 L=L+1
: INIT(2D)K9$
: FOR X=1TO 12
: Y$=STR(K$,X,1)
: IF Y$<HEX(20)THEN 6285
: IF Y$>HEX(7F)THEN 6285
: STR(K9$,X,1)=STR(Y$,1)
6285 NEXT X
: HEXPRINT K$;
: PRINT TAB(26);K9$;TAB(40);
: X=VAL(C2$)*256+VAL(STR(C2$,2))
: Y=VAL(C3$)
: PRINTUSING 6310,X,Y,STR(Q6$,1,11)
6310 %##### ### ###########
6315 RETURN
6330 GOSUB '50("ERROR X")
: PRINT HEX(0C)
: SELECT PRINT 005
: STOP "ERROR X"
6410 DATA LOAD BA T#2,(C0$,X1$)D$()
: IF STR(D$(1),1,2)=HEX(8101)THEN 6440
6430 GOSUB '61("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 '61("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 '61("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 '61("KEY FIELD OUT OF BOUNDS")
6880 IF STR(C$,N1,1)>HEX(80)THEN 6910
: GOSUB '61("NUMERIC KEY INVALID")
6910 K0=(P-3)*B+3+K0-P
: I=Y
: GOTO 5760
6990 DEFFN'60(Q6$)
: PRINT HEX(010A0A0A)
: PRINT Q6$
: RETURN
7050 DEFFN'61(Q6$)
: PRINT HEX(01)
: PRINT Q6$
: STOP
7130 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"
7190 GOSUB '245(X$,1,0)
: X=Q9
: IF X<1THEN 7250
: IF X>7THEN 7250
: GOSUB '248(5,0,5)
: RETURN
7250 PRINT HEX(010A0A0A)
: PRINT "INVALID DEVICE ADDRESS"
: GOTO 7190
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