image of READY prompt

Wang2200.org

Listing of file='@DOSCYCS' on disk='vmedia/731-8028-A.wvd.zip'

# Sector 312, program filename = '@DOSCYCS'
0010 REM %^ @DOSCYCS - UTILITY BY KIRIT BAXI EAME R&D
0020 REM % Version 1.0 20 JUN 1991
0030 REM ***********************************************
0040 REM *                                             *
0050 REM *              COPYCS   Program               *
0060 REM *                                             *
0070 REM ***********************************************
0100 REM % DEFINE VARIABLES
0110 DIM A$(16)32,B$(16)32,D$(16),B$4,C$16,D$3,E$4,F$11,G$2,H$8,K$1,J$12,J1$12
     ,L$2,M$4,N$1,O$1,P$1,Q$1,V$11,X$1
   : PRINT HEX(02050F)
   : N3=1
0120 IF STR(I2$,1,12)="            "THEN I2$=I1$
0130 REM % File name to copy from J$
   : C$=ALL(00)
   : MAT SEARCHI1$,=":"TO C$
   : C=VAL(C$,2)
   : IF C=0THEN DO
   : J$=I1$
   : END DO
   : IF C=0THEN 160
0140 IF C<>0THEN DO
   : IF LEN(I1$)>2THEN J$=STR(I1$,C+1)
   : IF LEN(I1$)<3THEN J$=I1$
   : IF STR(I1$,1,2)="A:"THEN N=N1
   : IF STR(I1$,1,2)="B:"THEN N=N2
   : IF STR(I1$,1,2)="C:"THEN N=N3
   : IF N=1THEN Q$="C"
   : IF N=2THEN Q$="A"
   : IF N=3THEN Q$="B"
   : END DO
0150 IF Q$="C"THEN STR(J$,9)=ALL(20)
   : GOTO 180
0160 IF C=0THEN DO
   : IF N=1THEN Q$="C"
   : IF N=2THEN Q$="A"
   : IF N=3THEN Q$="B"
   : END DO
0170 IF N=0THEN DO
   : IF W$="A:"THEN N=2
   : IF W$="B:"THEN N=3
   : IF N=2THEN Q$="A"
   : IF N=3THEN Q$="B"
   : END DO
0180 REM % File name to copy to J1$
   : C$=ALL(00)
   : MAT SEARCHI2$,=":"TO C$
   : C=VAL(C$,2)
   : IF C=0THEN DO
   : J1$=I2$
   : END DO
   : IF C=0THEN 210
0190 IF C<>0THEN DO
   : IF LEN(I2$)>2THEN J1$=STR(I2$,C+1)
   : IF LEN(I2$)=2THEN J1$=J$
   : IF STR(I2$,1,2)="A:"THEN N0=N1
   : IF STR(I2$,1,2)="B:"THEN N0=N2
   : IF STR(I2$,1,2)="C:"THEN N0=N3
   : IF N0=1THEN X$="C"
   : IF N0=2THEN X$="A"
   : IF N0=3THEN X$="B"
   : END DO
0200 IF X$="C"THEN STR(J1$,9)=ALL(20)
0210 IF C=0THEN DO
   : IF N0=1THEN X$="C"
   : IF N0=2THEN X$="A"
   : IF N0=3THEN X$="B"
   : END DO
0220 IF N0=0THEN DO
   : IF W$="A:"THEN N0=2
   : IF W$="B:"THEN N0=3
   : IF N0=2THEN X$="A"
   : IF N0=3THEN X$="B"
   : END DO
0230 REM % DETERMINE COPY TYPE  C >AORA>C
   : IF Q$="A"OR Q$="B"THEN 240
   : IF Q$="C"THEN 430
0240 REM % COPY FROM DOS TO CS STARTS HERE
   : N0=1
   : GOSUB 610
   : GOSUB 690
0250 REM % CHECK IF J$ EXISTS
   : DATA LOAD ACOPEN T#N,J$
   : ERRORE=ERR
0260 IF E<>0AND E=82THEN DO
   : PRINT HEX(070E);"File not Found ..."
   : END DO
   : IF E=82THEN 670
0270 LIMITS T#N,A1,B1,C1
0280 REM % Check IF J1$ EXISTS ELSE CREATE IT
   : LIMITS T#N0,J1$,A2,B2,C2,D2
   : ERRORE=ERR
   : IF E<>0THEN 950
0290 IF D2=2THEN 310
   : IF D2=0THEN DATA SAVE DC OPEN T#N0,((B1*2)+1)J1$
   : ERRORE=ERR
   : IF E<>0THEN 950
0300 GOTO 330
0310 REM %IF EXISTS PROMPTNEW NAME
   : IF X$="C"THEN DO
   : PRINT HEX(0E);X$;": File exists Please supply new name : ";
   : LINPUT J1$
   : $TRAN(J1$,T$())
   : END DO
   : IF J1$="  "THEN 670
0320 REM % Create new file with name J1$
   : DATA SAVE DC OPEN T#N0,((B1*2)+1)J1$
   : ERRORE=ERR
   : IF E=83THEN 310
0330 REM % FIND LIMITS OF THE NEW FILE
   : LIMITS T#N0,J1$,A2,B2,C2
0340 PRINT "Copying ... ";Q$;":";J$;"  To  ";X$;":";J1$
0350 REM % actual copy to C in progress
   : L=A2
   : F=0
0360 DATA LOAD AC#N,A$()
   : IF END THEN 390
0370 DATA SAVE BMT#N0,(L,L)A$()
   : F=F+512
0380 GOTO 360
0390 F=F+512
   : F1=F-A9
   : IF F1<>0THEN STR(A$(),(512-F1)+1)=ALL(20)
   : DATA SAVE BMT#N0,(L,L)A$()
   : DATA LOAD BA T#N0,(B2)D$()
   : STR(D$(),2,2)=BIN((B1*2),2)
   : STR(D$(),17,4)=BIN(A9,4)
   : STR(D$(),21,8)=STR(J1$,1,8)
   : DATA SAVE BA T#N0,(B2)D$()
0400 DATA SAVE ACCLOSE#N
0410 PRINT HEX(070E);"Copy Complete File ";X$;":";J1$;" created"
0420 GOTO 670
0430 REM % COPY FROM CS TO DOS STARTS HERE
0440 IF E=93THEN GOSUB 940
0450 REM % FIND THE PARAMETERS OF THE FILE TO COPY
   : LIMITS T#N,J$,A3,B3,C3,D3
   : IF D3=0THEN DO
   : PRINT HEX(070E);I1$;" not found"
   : END DO
   : IF D3=0THEN 670
0460 REM % RETRIEVE NO OF BYTES IN THE FILE
   : A8=0
   : DATA LOAD BA T#N,(B3)D$()
   : IF STR(D$(),1,1)<>HEX(A0)THEN 470
   : A8=VAL(STR(D$(),17,4),4)
   : IF A8=0THEN DO
   : G=MOD(C3+1,2)
   : IF G=0THEN A8=(C3+1)*256
   : IF G<>0THEN A8=C3*256
   : END DO
0470 GOSUB 640
   : PRINT "Copying ... ";Q$;":";J$;"  To  ";X$;":";J1$
0480 REM % VERIFY IF PLATTER IS FORMATTED
   : DATA LOAD BA T#N0,(0)D$()
   : ERRORE=ERR
0490 REM % VERIFY IF THE OUTPUT FILE EXISTS
   : DATA LOAD ACOPEN T#N0,J1$
   : ERRORE=ERR
0500 IF E<>82THEN 520
   : IF E=82THEN DO
   : DATA SAVE ACOPEN T#N0,(((B3-A3)+1)*2)J1$
   : ERRORE=ERR
   : IF E=86THEN PRINT HEX(070E);"Insufficient space to create file..."
0510 END DO
   : GOTO 530
0520 REM %IF EXISTS PROMPTNEW NAME
   : PRINT HEX(0E);X$;": File exists Please supply new name : ";
   : LINPUT J1$
   : $TRAN(J1$,T$())
   : IF J1$="   "THEN 670
0530 FOR X=A3TO A3+C3STEP 2
0540 DATA LOAD BMT#N,(X,K)A$()
0550 DATA SAVE AC#N0,A$()
0560 NEXT X
0570 IF A8=0THEN DO
   : DATA SAVE AC#N0,END
   : DATA SAVE ACCLOSE#N0
   : END DO
   : IF A8=0THEN GOTO 670
0580 DATA SAVE AC#N0,END
   : DATA SAVE ACCLOSE#N0
   : GOSUB 810
0590 GOTO 670
0600 REM % SUBROUTINES!
0610 PRINT " Insert Source diskette in drive '";Q$;"'";HEX(02050F)
0620 PRINT " Press ENTER to continue . . . ";
0630 KEYIN K$
   : IF POS(HEX(7E7FF0)=K$)<>0THEN 670
   : IF K$<>HEX(0D)THEN 630
   : PRINT K$;
   : RETURN
0640 PRINT " Insert output diskette in drive '";X$;"'";HEX(02050F)
0650 PRINT " Press ENTER to continue . . . ";
0660 KEYIN K$
   : IF POS(HEX(7E7FF0)=K$)<>0THEN 670
   : IF K$<>HEX(0D)THEN 660
   : PRINT K$;
   : RETURN
0670 REM % RET > CMD PROC
   : PRINT
   : I4$="R"
   : LOAD T"@DOS"
0680 END
0690 REM CALCULATE BYTES FOR THE FILE TO COPY
0700 C$=ALL(00)
   : F$=ALL(20)
   : MAT SEARCHJ$,="."TO C$
   : C=VAL(C$,2)
   : IF C=0THEN 710
   : STR(F$,1,8)=STR(J$,1,C-1)
   : STR(F$,9,3)=STR(J$,C+1,3)
   : GOTO 720
0710 F$=J$
0720 DATA LOAD BMT#N,(1440,M)A$()
   : ERRORE=ERR
   : IF E=98THEN Y=10
   : V=13
   : GOTO 740
0730 DATA LOAD BMT#N,(4800,M)A$()
   : ERRORE=ERR
   : IF E=98THEN Y=30
   : V=27
   : IF Y=0THEN DO
   : Y=10
   : V=13
   : END DO
0740 FOR Z=YTO Y+VSTEP 2
0750 DATA LOAD BMT#N,(Z,M)B$()
   : ERRORE=ERR
   : IF E<>0THEN 970
0760 FOR X=1TO 16
   : IF STR(B$(X),1,11)=STR(F$,1,11)THEN 770
   : ELSE GOTO 780
0770 REM % CALCULATE BYTES USED
   : E$=ALL(00)
   : STR(E$,3,1)=STR(B$(X),30,1)
   : STR(E$,4,1)=STR(B$(X),29,1)
   : STR(E$,1,1)=STR(B$(X),32,1)
   : STR(E$,2,1)=STR(B$(X),31,1)
   : A9=VAL(E$,4)
   : GOTO 800
0780 NEXT X
0790 NEXT Z
0800 RETURN
0810 REM % UPDATE  BYTES USED IN FILE JUST COPIED.
0820 C$=ALL(00)
   : F$=ALL(20)
   : MAT SEARCHJ1$,="."TO C$
   : C=VAL(C$,2)
   : IF C=0THEN 830
   : STR(F$,1,8)=STR(J1$,1,C-1)
   : STR(F$,9,3)=STR(J1$,C+1,3)
   : GOTO 840
0830 F$=J1$
0840 REM % GET THE DIRECTORY INFORMATION
0850 DATA LOAD BMT#N0,(1440,M)A$()
   : ERRORE=ERR
   : IF E=98THEN Y=10
   : V=13
   : GOTO 870
0860 DATA LOAD BMT#N0,(4800,M)A$()
   : ERRORE=ERR
   : IF E=98THEN Y=30
   : V=27
   : IF Y=0THEN DO
   : Y=10
   : V=13
   : END DO
0870 FOR Z=YTO Y+VSTEP 2
0880 DATA LOAD BMT#N0,(Z,M)B$()
0890 FOR X=1TO 16
   : IF STR(B$(X),1,11)=STR(F$,1,11)THEN 900
   : ELSE GOTO 910
0900 REM % CALCULATE BYTES USED
   : E$=BIN(A8,4)
   : STR(B$(X),30,1)=STR(E$,3,1)
   : STR(B$(X),29,1)=STR(E$,4,1)
   : STR(B$(X),32,1)=STR(E$,1,1)
   : STR(B$(X),31,1)=STR(E$,2,1)
   : GOTO 930
0910 NEXT X
0920 NEXT Z
0930 DATA SAVE BMT#N0,(Z,M)B$()
   : RETURN
0940 REM % FORMAT ROUTINE NOT NEEDED AT PRESENT
   : RETURN
0950 IF E>84AND E<87THEN PRINT HEX(070E);"Please check Drive C: - Catalog full
      or no Catalog found"
   : GOTO 670
0960 IF E=93THEN PRINT HEX(070E);"Please format Drive C:"
   : GOTO 670
0970 IF E=98THEN PRINT HEX(070E);"Please Insert a diskette in the Drive"
   : GOTO 670
0980 IF E=93THEN PRINT HEX(070E);"Format Error!"
   : GOTO 670