1 REM Ins{nt av 2635
10 ! **********************************************************************
20 ! Program          CPMCOPY.800      Utg}va  1.8      1984-01-15
30 ! av Kurt Nystr|m MYAB, {ndrad av Per Svebeck
40 ! Ins{nd av Per Svebeck
50 ! F|r ABC800M ABC802 ABC806
60 ! Testad p} ABC800M
70 ! Fungerar inte riktigt bra f|r CPM Plus-filer
80 ! Kan anv{ndas f|r att testa vad som finns p} CPM-skivor utan
90 ! att ha CPM installerat. Kan skriva ut textfiler p} skrivare,
100 ! eller kopiera filer till:
110 ! RAM: enhet om drivrutinen {r laddad
120 ! DR6: enhet om kort och drivrutiner finns
130 ! V24: |ver t ex modem till annan dator.
140 ! **********************************************************************
150 L=1 : REM set to 0 for english texts, 1 for swedish.
160 REM Program f|r att l{sa en CP/M-diskett och |verf|ra till
170 REM ABC-diskett
180 REM 
190 REM Programmet |verf|r textfiler eller bin{rfiler.
200 REM Vid |verf|ring av textfiler slutar |verf|ringen vid
210 REM f|rsta ctrl-Z. Linefeed byts mot return. Tab-tecken
220 REM expanderas. \vriga kontrolltecken ignoreras helt.
230 REM 
240 REM Denna version av programmet klarar godtyckligt stora filer.
250 REM 
260 REM Programmet skrivet av Kurt Nystr|m, MYAB Mikrokonsult AB
270 REM 1982-12-10.
280 REM 
290 REM 1983-01-09 vers 1.1
300 REM Buggar vid kopiering av stora filer (>32 sektorer) fixade.
310 REM 
320 REM 1984-01-05
330 REM Modifierat map heltal, printer, RAM: mm av P Svebeck
340 REM 
350 REM V$ = Versions nr
360 REM S1% = blocknr till f|rsta block i katalogen
370 REM S2% = blocknr till sista block i katalogen
380 REM A% = allokeringsstorlek i 256-bytes block
390 REM D% = drivenummer att l{sa ifr}n
400 REM X% = antal byte blocknr (1 om max 256 block, 2 annars)
410 REM S% = antal 128-bytessektorer per allokeringsblock
420 INTEGER : EXTEND 
430 Ver$='1.8'
440 Dummy$='DUMMY.TMP'
450 Printer$='PR:VSA46B72.5' ! 2400 BAUDRATE
460 Terminal$='V24:VEA30E24.2' ! 300 BAUDRATE
470 ! Terminal$='V24:VEA30E24.4' ! 1200 BAUDRATE
480 Tabb$=SPACE$(10)
490 Temp=1
500 DIM D$=0
510 POKE VAROOT(D$),0,1,0,245,0,1
520 DIM D2$(16)=256,D1$=256,U$=1000 ! U$ \kad fr}n 256 till 1000/PSk
530 DIM X(512) : REM tabell |ver allokerade block
540 ; CHR$(12) '*** CPMCOPY Version ' Ver$ ' ***'
550 POKE 65348,0 ! Nollst{ll ERRCODE
560 ; STRING$(80,61) : ; 
570 IF L THEN ; 'Program f|r kopiering av CP/M-flexskivor' ELSE ; 'Program for copying of CP/M-diskettes'
580 A$='1'
590 ; 
600 IF L=1 THEN ; 'Ange flexskiveenhet (1=830, 2=832, 3=838, 4=DD84) : ';
610 IF L=0 THEN ; 'Give drivetype (1=830, 2=832, 3=838, 4=DD84) : ';
620 INPUT ''A$
630 IF A$='1' THEN S1=32 : S2=39 : A=4 : D=1 : X=1 : S=8 : F$='DR0:' : GOTO 690 : REM 830
640 IF A$='2' THEN S1=32 : S2=39 : A=16 : D=9 : X=1 : S=32 : F$='MF0:' : GOTO 690 : REM 832
650 IF A$='3' THEN S1=26 : S2=41 : A=8 : D=1 : X=2 : S=16 : F$='SF0:' : GOTO 690 : REM 838
660 IF A$='4' THEN S1=32 : S2=39 : A=8 : D=1 : X=1 : S=16 : F$='DR0:' : GOTO 690 : REM DD84
670 IF A$<>'1' AND A$<>'2' AND A$<>'3' AND A$<>'4' THEN IF L THEN ; 'Felaktig disktyp' ELSE ; 'Wrong type of drive'
680 GOTO 600
690 IF L THEN ; 'Textfiler eller bin{rfiler (T/B): '; ELSE ; 'Textfiles or Binary files (T/B): ';
700 INPUT ''A$ : IF A$='b' OR A$='B' THEN B9=1 ELSE B9=0
710 IF L=0 THEN 840
720 ; 'S{tt CP/M-flexskivan i enhet DR1:'
730 ; 
740 ; 'D - Kopiering till enhet DR0: till fil med samma namn'
750 ; 'R - Kopiering till enhet RAM: till fil med samma namn'
760 ; '6 - Kopiering till enhet DR6: till fil med samma namn'
770 ; 'L - Listning p} sk{rmen'
780 ; 'P - Listning p} printer'
790 ; 'V - S{ndning p} port B (dvs V24:) |ver t ex modem (300 Baud)'
800 ; 'A - Avbryt programmet'
810 ; 
820 ; 'Ge val (D,R,6,L,P,V,A): ';
830 GOTO 950
840 ; 'Put the CP/M-diskette in drive DR1:'
850 ; 
860 ; 'D - Copying to files with same name on drive DR0:'
870 ; 'R - Copying to files with same name on drive RAM:'
880 ; '6 - Copying to files with same name on drive DR6:'
890 ; 'L - List files on screen'
900 ; 'P - List files on printer'
910 ; 'V - List files on V24:, eg Modem transmision (300 Baud)'
920 ; 'A - Abandon program'
930 ; 
940 ; 'Give command (D,R,6,L,P,V,A): ';
950 INPUT ''A$
960 IF A$>'b' THEN A$=CHR$(ASCII(A$)-32)
970 IF A$='D' THEN K9=1 : Pr=0 : GOTO 1050
980 IF A$='R' THEN K9=1 : Pr=0 : F$='RAM:' : GOTO 1050
990 IF A$='6' THEN K9=1 : Pr=0 : F$='DR6:' : GOTO 1050
1000 IF A$='L' THEN K9=0 : Pr=0 : GOTO 1050
1010 IF A$='P' THEN K9=0 : Pr=2 : GOTO 1050
1020 IF A$='V' THEN K9=0 : Pr=3 : GOTO 1050
1030 IF A$='A' OR A$='a' THEN Pr=0 : GOTO 2000
1040 GOTO 710
1050 REM 
1060 ON ERROR GOTO 1090
1070 IF F$='RAM:' THEN PREPARE F$+Dummy$ AS FILE 9 : CLOSE 9 : KILL F$+Dummy$
1080 IF F$='DR6:' THEN PREPARE F$+Dummy$ AS FILE 9 : CLOSE 9 : KILL F$+Dummy$
1090 IF ERRCODE=21 THEN ; "Drivrutiner f|r RAM: inte inlagda !" : GOTO 1960
1100 IF Pr=2 THEN OPEN Printer$ AS FILE Pr
1110 IF L THEN ; : ; 'Filnamnen p} CP/M-flexskivan kommer att r{knas upp.'
1120 IF L=0 THEN ; : ; 'The filenames on the CP/M-diskette will be displayed.'
1130 R1=1
1140 FOR B=S1 TO S2
1150   GOSUB 2150 : D2$(B-S1)=D$
1160 NEXT B 
1170 FOR K=0 TO S2-S1
1180   FOR J=2 TO 250 STEP 32
1190     IF R1 THEN GOSUB 2020
1200     R1=0
1210     S7=K : B7=J : GOSUB 2420
1220     IF N<0 THEN GOTO 1860 : REM Ledigt entry
1230     REM Skriv ut filnamnet.
1240     ; N$;' '; : N1$=N$ : N1=0 : N2=0 : X1=0
1250     REM Plocka fram vilka blocknummer som {r allokerade till filen.
1260     FOR I1=B7+15 TO B7+30 STEP X
1270       IF X=1 THEN E=ASCII(MID$(D2$(S7),I1,1))
1280       IF X<>1 THEN E=ASCII(MID$(D2$(S7),I1,1))+256*ASCII(MID$(D2$(S7),I1+1,1))
1290       IF E<>0 THEN X1=X1+1 : X(X1)=E : N2=N2+S
1300     NEXT I1 
1310     REM Markera detta entry som tomt.
1320     MID$(D2$(S7),B7-1,1)=CHR$(229)
1330     N1=N1+N
1340     IF N<128 THEN 1380
1350     GOSUB 2530 : IF S7>S2-S1 THEN 1380
1360     GOSUB 2420 : IF N<0 OR N1$<>N$ THEN 1350
1370     GOTO 1260 : REM Ytterligare ett entry f|r samma fil.
1380     N1=(N2 AND (511*128))+(N1 AND 127)
1390     A$=NUM$(N1)
1400     ; SPACE$(5-LEN(A$));A$;' block,';
1410     A$=NUM$(INT((N1+7)/8)) : ; SPACE$(5-LEN(A$));A$;' kbyte ';
1420     INPUT A$ : IF A$='a' OR A$='A' THEN 2000
1430     IF A$<>'j' AND A$<>'J' AND A$<>'y' AND A$<>'Y' THEN 1860
1440     IF L=1 AND K9=0 AND Pr<2 THEN ; "Tryck p} en tangent f|r att l{sa filen !" : ; 
1450     IF L=0 AND K9=0 AND Pr<2 THEN ; "Press any button to read the file !" : ; 
1460     IF Pr=2 THEN ; #Pr,Tabb$+"CP/M-fil: " N$ : ; #Pr : ; #Pr
1470     IF Pr=3 THEN GOSUB 2210
1480     U$='' : IF K9=0 THEN R1=1
1490     R9=0
1500     A$=N1$ : A1$='' : A0$=''
1510     FOR I=1 TO LEN(A$) : A2$=MID$(A$,I,1) : IF A2$<>' ' THEN A1$=A1$+A2$
1520     NEXT I 
1530     A0$=A1$
1540     IF LEFT$(A1$,1)<'A' OR LEFT$(A1$,1)>'^' THEN A1$='X'+RIGHT$(A1$,2)
1550     POKE 65348,0,0 ! Nollst{ll ERRCODE
1560     ON ERROR GOTO 1580
1570     IF K9=1 THEN Ut=1 : PREPARE F$+A1$ AS FILE Ut
1580     IF ERRCODE=21 THEN A1$="TEMP"+NUM$(Temp)+".][\" : PREPARE F$+A1$ AS FILE Ut
1590     ON ERROR GOTO 1790
1600     FOR I1=1 TO X1
1610       B1=X(I1)*A+S1
1620       FOR B=B1 TO B1+A-1
1630         GOSUB 2150
1640         D1$=D$
1650         IF B9 THEN PUT #Ut,D1$ : GOTO 1740
1660         FOR M=1 TO 256
1670           A$=MID$(D1$,M,1)
1680           IF A$>=" " THEN U$=U$+A$ : GOTO 1720
1690           IF A$=CHR$(9) THEN U$=U$+SPACE$(8-MOD(LEN(U$),8))
1700           IF A$=CHR$(10) THEN GOSUB 2260
1710           IF A$=CHR$(26) THEN GOSUB 2340 : GOTO 1830
1720         NEXT M 
1730         N1=N1-1 : IF N1=0 THEN GOTO 1830
1740       NEXT B 
1750     NEXT I1 
1760     POKE 65348,0,0 ! Nollst{ll ERRCODE
1770     GOTO 1830
1780     REM Felhantering vid l{sning av filer
1790     IF ERRCODE=137 AND L=1 THEN ; "Kan inte l{sa, f|r l}nga rader (>1000 tecken)" : ; : GOTO 1860
1800     IF ERRCODE=137 AND L=0 THEN ; "Can't read, lines too long (>1000 char)" : ; : GOTO 1860
1810     IF L=1 THEN ; "Felkod :" ERRCODE ELSE ; "Error: " ERRCODE
1820     STOP 
1830     IF B9 THEN CLOSE Ut
1840     ; 
1850     IF Pr=3 THEN GOTO 1880 ! S{nd bara en fil i taget
1860   NEXT J 
1870 NEXT K 
1880 IF Pr=2 OR Pr=3 THEN CLOSE Pr
1890 IF L=1 AND Pr=3 THEN ; "S{ndning avslutad"
1900 IF L=0 AND Pr=3 THEN ; "Transmisson finnished"
1910 ; : ; 
1920 IF L=1 THEN ; "Tryck p} en tangent !"
1930 IF L=0 THEN ; "Press any button !"
1940 ; CHR$(7) : GET A$
1950 ; 
1960 IF L=1 THEN INPUT "Kopiera mera (j/n) ? "A$
1970 IF L=0 THEN INPUT "More copies (y/n) ? "A$
1980 IF A$<>'j' AND A$<>'J' AND A$<>'y' AND A$<>'Y' THEN 1990 ELSE 690
1990 ! 
2000 END 
2010 ! 
2020 IF L THEN 2090
2030 ; 'Answer Y to copy or list the file, A to abandon program.'
2040 ; 
2050 ; '  Name         Size'
2060 ; 
2070 RETURN 
2080 ! 
2090 ; 'Svara J f|r att kopiera filen och A f|r att avbryta.'
2100 ; 
2110 ; '  Filnamn    Storlek'
2120 ; 
2130 RETURN 
2140 ! 
2150 REM rutin som l{ser ett block till D$
2160 POKE -767,D
2170 I=CALL(24678,B*32)
2180 RETURN 
2190 ! 
2200 REM Rutin f|r att |ppna terminalmoden
2210 OPEN Terminal$ AS FILE Pr
2220 IF L=1 THEN ; "Terminallinjen |ppnad, knyt ihop med motabbonenten !"
2230 IF L=0 THEN ; "Transmisson line open, call the other part !"
2240 RETURN 
2250 ! 
2260 REM behandling av den f{rdiga raden U$
2270 IF K9=0 AND Pr<2 THEN GET Q$ : ; U$
2280 IF K9=1 THEN ; #Ut,U$ : ; 'Rad' R9;CHR$(13); : R9=R9+1
2290 IF K9=0 AND Pr=2 THEN ; #Pr,Tabb$+U$ : ; 'Rad' R9;CHR$(13); : R9=R9+1
2300 IF K9=0 AND Pr=3 THEN ; #Pr,Tabb$+U$ : ; 'Rad' R9;CHR$(13); : R9=R9+1
2310 U$=''
2320 RETURN 
2330 ! 
2340 REM hantering vid filslut
2350 IF LEN(U$)>0 THEN GOSUB 2260
2360 IF K9=1 THEN CLOSE Ut
2370 IF L=1 AND K9=1 THEN ; "Filen " A0$ " kopierad med filnamn " F$+A1$
2380 Temp=Temp+1
2390 IF K9=0 AND (Pr=2 OR Pr=3) THEN ; #Pr,CHR$(12)
2400 RETURN 
2410 ! 
2420 REM Denna rutin tar fram n{sta entry ur katalogen.
2430 REM sektornummer = S7% , bytenummer i sektorn = B7%
2440 REM filnamnet hamnar i N$ (med punkt)
2450 N=-1
2460 B=S7
2470 IF MID$(D2$(B),B7-1,1)=CHR$(229) THEN RETURN 
2480 IF (B9=0) AND (MID$(D2$(B),B7+8,3)='COM') THEN RETURN 
2490 N$=MID$(D2$(B),B7,8)+'.'+MID$(D2$(B),B7+8,3)
2500 N=ASCII(MID$(D2$(B),B7+14,1))
2510 RETURN 
2520 ! 
2530 REM Uppr{kning av sektor- och byteindex till n{sta entry.
2540 B7=B7+32
2550 IF B7<255 THEN RETURN 
2560 S7=S7+1
2570 B7=2
2580 RETURN