image of READY prompt

Wang2200.org

Listing of file='IDS2PU01' on disk='vmedia/701-2715B.wvd.zip'

# Sector 497, program filename = 'IDS2PU01'
1000 REM "IDS2PU01" - Release 2.1 - PROTECT/RELEASE RECORDS -- UTILITIES
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : DIM C5$8,C6$8
   : MAT REDIM E4$(64)4
   : E3$()=ALL(00)
   : IF G<>2THEN G=1
1040 GOSUB '32("IDS2sSC0")
   : E$()=E9$(1)
   : PRINT AT(0,7);HEX(020402000E);"Supplementary Utilities/";
   : IF G=1THEN PRINT "Protect Every Record";
   : IF G=2THEN PRINT "Release Every Record";
   : PRINT HEX(0F);AT(11,42);"file to be"
   : IF G=1THEN E$=" protected"
   : IF G=2THEN E$=" released"
   : PRINT AT(11,53);E$
   : IF G=2THEN G1=2
   : IF G=1THEN G1=1
   : G=0
1070 GOSUB '34(1)
   : E9$(1)=E$
   : C6$=E$
   : C5$=C6$OR ALL(20)
   : GOSUB '39(C5$,5)
   : IF Q=2THEN 1130
   : GOSUB '38(92," ")
   : GOTO 1070
1130 MAT SEARCHE1$(),=STR(C6$,,8)TO F9$STEP 8
   : D4=INT((VAL(F9$,2)+55)/56)
   : MAT REDIM E2$(6)83
   : DATA LOAD DA T#P,(A)E2$()
   : STR(E2$(),251,3)=STR(E2$(),105)
   : CONVERT STR(E2$(),10,1)TO D2
   : IF D2>1THEN 1160
   : GOSUB '38(93," ")
   : E$=" "
   : GOTO 1040
1160 IF D2<5THEN 1170
   : GOSUB '38(94," ")
   : C6$=STR(E2$(),82,8)
   : F=1
   : GOSUB '45(1,C6$)
   : E$=" "
   : GOTO 1040
1170 IF D4>0THEN 1180
   : MAT REDIM E3$(9)83
   : F2$="IDS2fs  "
   : IF R0<#PARTTHEN STOP #
   : A=(R0-#PART)/16+1
   : IF A>0THEN CONVERT ATO STR(F2$,7,2),(##)
   : DATA LOAD DC OPEN T#2,F2$
   : DATA LOAD DC #2,E3$()
   : F$()=STR(E3$(),#PART*45-17,45)
1180 CONVERT STR(E2$(),217,1)TO C9
   : J7=0
   : CONVERT STR(E2$(),209,8)TO J6
   : PRINT AT(20,22);BOX(1,34);" Processing is       % complete."
   : FOR J=0TO C9-1
   : IF D4=0THEN 1220
   : J9=VAL(STR(E1$(D4+J),9))
   : GOTO 1230
1220 MAT SEARCHF$(),=STR(E2$(),251+J*3,3)TO F9$STEP 3
   : J9=INT((VAL(F9$,2)+2)/3)
1230 C2=VAL(STR(E2$(),442,1))
   : GOSUB '39(C6$,J9)
   : J9=P
   : IF N<=M-A+1THEN 1250
   : GOSUB '38(95," ")
   : END
1250 C4=VAL(STR(E2$(),437,1))
   : IF J>0THEN C4=0
   : CONVERT STR(E2$(),218,4)TO C7
   : C6=VAL(STR(E2$(),435,2),2)
   : IF D2=4THEN 1340
   : D6=((N-2)/C6)-C4
   : IF D6<1THEN 1490
   : C8=D6/C2
   : C8=INT(C8)+SGN(C8-INT(C8))
   : CONVERT STR(E2$(),224,3)TO D7
   : D9=1
   : GOTO 1360
1340 D6=VAL(STR(E2$(),438,2),2)
   : C2=8
   : C8=D6/C2
   : D7=VAL(STR(E2$(),234),2)/C8
   : C7=VAL(STR(E2$(),419))
   : C4=0
   : C8=C8+1
1360 DATA LOAD BA T#J9,(0)E4$()
   : D5=VAL(STR(E4$(),2))
   : FOR J1=1TO C6
   : IF C8=1AND D2<>4THEN 1420
   : MAT REDIM E3$(3*C2)83
   : FOR J2=1TO C8-1
   : Y=A+(J1-1)*D6+J1*C4+(J2-1)*C2
   : DATA LOAD DA T#J9,(Y)E3$()
   : C3=INT((249*C2-D7*C7)/D7)
   : IF D2=4THEN C3=0
   : IF D2=4THEN D9=VAL(STR(E3$(),3,1))+VAL(STR(E2$(),416))
1390 FOR J3=1TO D7
   : STR(E3$(),D9+(J3-1)*(C7+C3),1)=BIN(R0)
   : IF G1=2THEN STR(E3$(),D9+(J3-1)*(C7+C3),1)=HEX(FF)
   : J7=J7+1
   : PRINT AT(20,38);INT(100*J7/J6);
   : NEXT J3
   : IF Y>D5THEN 1395
   : GOSUB '38(96," ")
   : END
1395 DATA SAVE DA T#J9,(Y)E3$()
   : NEXT J2
   : IF D2=4THEN 1470
1420 D1=MOD((D6-C4),C2)
   : IF D1=0THEN D1=C2
   : MAT REDIM E3$(3*D1)83
   : Y=A+(J1-1)*D6+J1*C4+J2*C2
   : DATA LOAD DA T#J9,(Y)E3$()
   : D8=D7
   : D7=LEN(E3$())/C7
   : FOR J3=1TO D7
   : STR(E3$(),1+(J3-1)*(C7+C3),1)=BIN(R0)
   : IF G1=2THEN STR(E3$(),1+(J3-1)*(C7+C3),1)=HEX(FF)
   : J7=J7+1
   : PRINT AT(20,38);INT(100*J7/J6);
   : NEXT J3
   : IF Y>D5THEN 1455
   : GOSUB '38(96," ")
   : END
1455 DATA SAVE DA T#J9,(Y)E3$()
   : D7=D8
1470 NEXT J1
1490 NEXT J
   : G1=0
   : GOSUB '39(R3$(1),4)
   : LOAD T#P,R3$(1)1000,
3010 DEFFN'0"LIST S HEX(03) D 10,";HEX(0D)
   : ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PU01"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"