1 REM Ins{nd av Stefan Gartz <2600>    1988-03-30 07.14.36 (KERMIT)
10 ! list bunt
20 EXTEND : INTEGER 
30 DIM Rad$=200
40 Sep$='%&'
50 In=1 : Ut=2 : Tmp=3
60 ON ERROR GOTO 60
70 ; CHR$(12) : ; CUR(3,5) 'BUNT'
80 ; 
90 ; 'Program f|r att sl} ihop och dela upp separata textfiler'
100 ; 'det kan anv{ndas f|r att sl} ihop samh|rande filer f|r att'
110 ; 'l{ttare kunna s{nda in och h{mta filer i programbanken.'
120 ; 'Det f}r inte finnas ' Sep$ ' i f|rsta position p} n}gon rad'
130 ; 
140 ; 'Aktuell bunt=' Bunt$
150 ; 
160 ; '1  Packa upp hela bunten'
170 ; '2  Packa upp s{rskild fil'
180 ; '3  Packa ner i bunten'
190 ; '4  Visa inneh}llet i bunten'
200 ; '9  V{lj nytt buntnamn'
210 ; '0  Avsluta'
220 ; CUR(22,0);
230 CLOSE 
240 INPUT '   Val='Nr$
250 S|k$=''
260 IF Nr$='1' THEN Z=FNSplit
270 IF Nr$='2' THEN ; CUR(22,0); : INPUT ' Ange s|kt fil 'S|k$ : S|k$=FNRise$(S|k$) : Z=FNSplit
280 IF Nr$='3' THEN Z=FNPack
290 IF Nr$='4' THEN Z=FNLib
300 IF Nr$='9' THEN ; CUR(22,0); : INPUT '   Buntnamn ? 'Bunt$ : Bunt$=FNRise$(Bunt$)
310 IF Nr$='0' THEN GOTO 330
320 GOTO 60
330 ! 
340 END 
350 DEF FNLib
360   IF Bunt$='' THEN RETURN -1
370   ON ERROR GOTO 520
380   OPEN Bunt$ AS FILE In
390   FOR Z=1 TO 4
400     INPUT LINE #In Rad$
410     IF INSTR(1,Rad$,Sep$)=1 THEN GOTO 430
420   NEXT Z 
430   ! 
440   IF INSTR(1,Rad$,Sep$)<>1 THEN ; 'filen ej "buntad" eller fel separator' : GET Sg$ : RETURN -1
450   WHILE 1
460     Rad$=''
470     WHILE INSTR(1,Rad$,Sep$)<>1
480       INPUT LINE #In Rad$
490     WEND 
500     ; RIGHT$(Rad$,LEN(Sep$)+1); : GET Sg$
510   WEND 
520   CLOSE 
530   IF ERRCODE=34 THEN ; 'Slut' ELSE ; 'Fel ' ERRCODE
540   GET Sg$
550   RETURN 0
560 FNEND 
570 DEF FNSplit
580   IF Bunt$='' THEN RETURN -1
590   ON ERROR GOTO 850
600   OPEN Bunt$ AS FILE In
610   FOR Z=1 TO 4
620     INPUT LINE #In Rad$
630     IF INSTR(1,Rad$,Sep$)=1 THEN GOTO 650
640   NEXT Z 
650   ! 
660   IF INSTR(1,Rad$,Sep$)<>1 THEN ; 'filen ej "buntad" eller fel separator' : GET Sg$ : RETURN -1
670   ON ERROR GOTO 870
680   Rad$=''
690   WHILE 1 ! till slut p} filen
700     ! 
710     WHILE INSTR(1,Rad$,Sep$)<>1 ! l{s fram till startm{rke
720       INPUT LINE #In Rad$
730     WEND 
740     IF S|k$<>'' THEN IF INSTR(1,Rad$,S|k$)<3 THEN Rad$='' : GOTO 700
750     Rad$=LEFT$(Rad$,LEN(Rad$)-2)
760     PREPARE RIGHT$(Rad$,LEN(Sep$)+1) AS FILE Ut
770     ; CUR(22,0) SPACE$(80) CUR(22,0) 'Packar ur ' RIGHT$(Rad$,LEN(Sep$)+1)
780     INPUT LINE #In Rad$
790     WHILE INSTR(1,Rad$,Sep$)<>1 ! l{s och skriv fram till n{sta startm{rke
800       PRINT #Ut Rad$;
810       INPUT LINE #In Rad$
820     WEND 
830     CLOSE Ut
840   WEND 
850   ! Open error
860   IF ERRCODE=21 RETURN -1
870   ! Read or write error
880   IF ERRCODE<>34 THEN ; 'Fel=' ERRCODE : STOP 
890   ! 
900   RETURN 0
910 FNEND 
920 ! 
930 DEF FNPack
940   IF Bunt$='' THEN RETURN -1
950   WHILE 1
960     ON ERROR GOTO 1070
970     OPEN Bunt$ AS FILE Ut
980     FOR Z=1 TO 4
990       INPUT LINE #Ut Rad$
1000       IF INSTR(1,Rad$,Sep$)=1 THEN GOTO 1020
1010     NEXT Z 
1020     ! 
1030     IF INSTR(1,Rad$,Sep$)<>1 THEN ; 'filen ej "buntad" eller fel separator' : GET Sg$ : RETURN -1
1040     PREPARE 'xyzxyz.tmp' AS FILE Tmp
1050     PRINT #Tmp Sep$
1060     GOTO 1190
1070     IF ERRCODE=21 THEN GOTO 1090
1080     ; 'Fel' ERRCODE : STOP 
1090     ; CUR(22,0) Bunt$ ' saknas ska den skapas ? ';
1100     INPUT ''Nya$
1110     IF INSTR(1,' Jj',Nya$)<2 THEN GOTO 1170
1120     PREPARE Bunt$ AS FILE Ut
1130     PRINT #Ut Sep$
1140     PRINT #Ut 'Filen ' Bunt$ ' {r skapad med BUNT.BAS'
1150     CLOSE 
1160     GOTO 960
1170     ! 
1180     RETURN -1
1190     ! 
1200     ON ERROR GOTO 1250
1210     ; CUR(22,0) SPACE$(80) CUR(22,0) ' Ange fil du vill stoppa in i ' Bunt$; : INPUT ' 'Nya$ : Nya$=FNRise$(Nya$)
1220     IF Nya$='' THEN RETURN -1
1230     OPEN Nya$ AS FILE In
1240     GOTO 1270
1250     IF ERRCODE=21 THEN ; ' Finns ej ' : GET Sg$ ELSE ; ' Fel ' ERRCODE : GET Sg$
1260     GOTO 1200
1270     ON ERROR GOTO 1430
1280     WHILE 1
1290       INPUT LINE #Ut,Rad$
1300       WHILE INSTR(1,Rad$,Sep$+Nya$)<>1
1310         PRINT #Tmp Rad$;
1320         INPUT LINE #Ut,Rad$
1330       WEND 
1340       Rad$=''
1350       WHILE INSTR(1,Rad$,Sep$)<>1
1360         INPUT LINE #Ut,Rad$
1370       WEND 
1380       WHILE 1
1390         PRINT #Tmp Rad$;
1400         INPUT LINE #Ut Rad$
1410       WEND 
1420     WEND 
1430     IF ERRCODE<>34 THEN ; 'Fel' ERRCODE : STOP 
1440     ON ERROR GOTO 1510
1450     PRINT #Tmp Sep$ Nya$
1460     WHILE 1
1470       INPUT LINE #In,Rad$
1480       IF INSTR(1,Rad$,Sep$)=1 THEN ; 'Tecknen ' Sep$ ' finns felaktigt i filen ' Nya$ : STOP 
1490       PRINT #Tmp,Rad$;
1500     WEND 
1510     ! 
1520     IF ERRCODE<>34 THEN ; 'fel' ERRCODE : STOP 
1530     CLOSE 
1540     KILL Bunt$
1550     NAME 'xyzxyz.tmp' AS Bunt$
1560   WEND 
1570 FNEND 
1580 DEF FNRise$(I$) LOCAL Ch,Count
1590   Count=LEN(I$)
1600   WHILE Count
1610     Ch=ASCII(MID$(I$,Count,1))
1620     IF Ch>95 AND Ch<128 THEN MID$(I$,Count,1)=CHR$(Ch AND 223)
1630     Count=Count-1
1640   WEND 
1650   RETURN I$
1660 FNEND