10 ! ================================================
20 ! program    F[LTKOMP.BAC
30 ! version    2.0
40 ! 1984-04-07
50 ! 
60 ! ( C ) Leif Eriksson    < 397 >
61 ! G{vle    026-195271
70 ! 
90 ! ================================================
100 ! 
101 ! OBS !!!!!!!! Detta program fungerar inte riktigt, utan f}r ses som
102 ! ett utkast till ett b{ttre program.
103 ! 
110 INTEGER : EXTEND 
130 PRINT CHR$(12)
140 PRINT CUR(22,0) STRING$(80,61)
150 PRINT CUR(0,0) STRING$(80,61)
160 PRINT CUR(2,0) STRING$(80,61)
170 PRINT CUR(1,0) '    ABC800  databas    [ndra f{lten.     ver. 2.0 ' TAB(80) ''
180 ! 
190 DEF FNSudda$
200   FOR I=3 TO 20
210     PRINT CUR(I,0) SPACE$(80);
220   NEXT I 
230   RETURN ''
240 FNEND 
250 ! 
260 DEF FNInp$(Text$,Leng) LOCAL Var$=160,Slask$=1
270   Var$=''
280   PRINT Text$+Var$+STRING$(Leng-LEN(Var$),95) Text$+Var$;
290   GET Slask$
295   IF ASCII(Slask$)>=192 THEN CLOSE : CHAIN 'meny'
300   ON INSTR(1,CHR$(13,8,24),Slask$)+1 GOTO 340,310,330,270
310   PRINT SPACE$(Leng-LEN(Var$));
320   RETURN Var$
330   IF LEN(Var$)>0 THEN Var$=LEFT$(Var$,LEN(Var$)-1)
340   IF (ASCII(Slask$)>31 AND ASCII(Slask$)<128) THEN IF LEN(Var$)<Leng THEN Var$=Var$+Slask$ ELSE ; CHR$(7);
350   GOTO 280
360 FNEND 
370 ! 
380 DEF FNConv$(Name$) LOCAL I
390   WHILE I<>LEN(Name$)
400     I=I+1
410     IF ASCII(MID$(Name$,I,1))>95 AND ASCII(MID$(Name$,I,1))<127 THEN MID$(Name$,I,1)=CHR$(ASCII(MID$(Name$,I,1))-32)
420   WEND 
430   RETURN Name$
440 FNEND 
450 ! 
3980 ! 
3990 ! 
4000 ! ******************** huvudprogram ********************
4010 PRINT FNSudda$
4020 PRINT CUR(5,0) 'S{tt i en iordningst{lld men tom skiva i DR0: /den v{nstra luckan/'
4030 PRINT CUR(7,0) 'och en registerskiva i DR1: /den h|gra luckan/'
4040 PRINT CUR(21,0) 'Tryck p} en PF tangent f|r }terg}ng till Menyn.'
4050 PRINT CUR(9,0) 'Tryck p} Return n{r du {r klar!'
4060 P$=FNInp$(CUR(11,0)+'',1)
4070 ON ERROR GOTO 4240
4080 OPEN 'DR1:DATA.ID' AS FILE 1
4085 GET #1,Temp$ COUNT 2
4090 POSIT #1,6
4100 GET #1,P$ COUNT 12
4130 Postant=CVT$%(Temp$)
4140 CLOSE 
4150 PRINT CUR(12,0) 'DR1: inneh}ller register ' P$
4160 P$=FNInp$(CUR(14,0)+'[r det OK (J/N) ',1)
4190 P$=FNConv$(P$)
4200 IF P$='N' THEN GOTO 4000
4210 IF P$<>'J' THEN ; CHR$(7) : GOTO 4150
4220 GOTO 4340
4230 ! 
4240 ! ---------- fel ----------
4245 PRINT FNSudda$
4250 PRINT CUR(5,0) 'FEL nummer: ' ERRCODE ' p} h|gra driven!!'
4260 ; 
4270 PRINT 'Sitter det verkligen en DATA-skiva d{r ??'
4280 PRINT 
4290 ! 
4300 PRINT 'OBS!! |ppna inte luckan f|rr{n den r|da lysdioden slocknat !'
4320 P$=FNInp$(CUR(11,0)+'Tryck p} Return ',1)
4330 GOTO 4000
4340 ! 
4350 ON ERROR GOTO 4510
4360 OPEN 'DR0:DATA.ID' AS FILE 1
4370 PUT #1,CVT%$(Postant)
4380 CLOSE 
4390 ! 
4400 OPEN 'DR0:DATA.ISM' AS FILE 1
4410 POSIT #1,1
4420 GET #1 P$
4430 Temp=ASCII(P$)
4440 Temp=Temp-1
4450 P$=CHR$(Temp)
4460 POSIT #1,1
4470 PUT #1 P$
4480 CLOSE 
4490 GOTO 4601
4500 ! ---------- fel ----------
4510 PRINT FNSudda$
4520 PRINT CUR(5,0) 'FEL  nummer: ' ERRCODE ' p} v{nstra driven.'
4530 PRINT 
4540 PRINT 'Sitter det verkligen en formatterad tom skiva d{r?'
4550 ; 
4560 PRINT 'OBS !! |ppna inte luckan f|rr{n den r|da lysdioden slocknat !'
4580 P$=FNInp$(CUR(11,0)+'Tryck p} Return ',1)
4590 GOTO 4000
4600 ! ---------------------------------------------------
4601 PRINT FNSudda$
4602 PRINT CUR(5,0) 'Detta tar en bra stund, s} ha t}lamod.'
4610 ! b}da skivorna OK
4620 ! nu flyttar vi |ver registret
4630 OPEN 'DR1:DATA.ID' AS FILE 1
4640 POSIT #1,2
4650 GET #1,P$ COUNT 2
4660 F{ltantal(1)=CVT$%(P$)
4670 CLOSE 
4680 OPEN 'DR0:DATA.ID' AS FILE 1
4690 POSIT #1,2
4700 GET #1,P$ COUNT 2
4710 F{ltantal(0)=CVT$%(P$)
4720 CLOSE 
4721 OPEN 'DR0:DATA.ISM' AS FILE 1
4722 POSIT #1,25
4723 GET #1,P$ COUNT 2
4724 Postl=CVT$%(P$)
4725 DIM I$=Postl
4726 CLOSE 
4730 ! j{mf|r antalf{lt p} nya och gamla register
4740 ISAM OPEN 'DR0:DATA.ISM' AS FILE 2
4750 ISAM OPEN 'DR1:DATA.ISM' AS FILE 1
4760 IF F{ltantal(0)=F{ltantal(1) THEN 4940
4770 ! 
4780 OPEN 'DR0:DATA.ID' AS FILE 3
4785 POSIT #3,18
4790 FOR I=1 TO F{ltantal(0)
4800   GET #3,P$ COUNT 14
4810 NEXT I 
4820 L=CVT$%(LEFT$(P$,2)) : CLOSE 3
4830 ! 
4840 ON ERROR GOTO 5780 : Nr=1
4845 PRINT CUR(10,0) 'Jag flyttar nu post ' Nr ' av ' Postant : Nr=Nr+1
4850 ISAM READ #1,I$ FIRST 
4860 I$=I$+SPACE$(L)
4870 ISAM WRITE #2,I$
4880 FOR I=1 TO Postant-1
4885   PRINT CUR(10,0) 'Jag flyttar nu post ' Nr ' av ' Postant : Nr=Nr+1
4890   ISAM READ #1,I$ NEXT 
4900   I$=I$+SPACE$(L)
4910   ISAM WRITE #2,I$
4920 NEXT I 
4930 GOTO 5350
4940 ! ---------------------------------------------------
4950 ! |ka ut ett f{lt
4960 DIM L0(12),L1(12)
4970 OPEN 'DR0:DATA.ID' AS FILE 3
4980 POSIT #3,18
4990 FOR I=1 TO F{ltantal(0)
5000   GET #3,P$ COUNT 2
5010   GET #3,Dummy$ COUNT 12 ! anv{nds inte
5020   L0(I)=CVT$%(P$)
5030 NEXT I 
5040 CLOSE 3
5050 ! 
5060 OPEN 'DR1:DATA.ID' AS FILE 4
5070 POSIT #4,18
5080 FOR I=1 TO F{ltantal(0)
5090   GET #4,P$ COUNT 2
5100   GET #4,Dummy$ COUNT 12 ! anv{nds inte
5110   L1(I)=CVT$%(P$)
5120 NEXT I 
5130 CLOSE 4
5140 ! 
5150 ! r{kna ut var space ska skjutas in
5160 FOR I=1 TO F{ltantal(0)
5170   IF L0(I)=L1(I) THEN 5210
5180   Skillnad=L0(I)-L1(I)
5190   Nummer=I
5200   GOTO 5220
5210 NEXT I 
5220 ! 
5230 ! var n}gonstans i posten
5240 FOR I=1 TO Nummer
5250   Position=Position+L1(I)
5260 NEXT I 
5270 ! flytta |ver posterna
5271 Nr=1
5275 PRINT CUR(10,0) 'Jag flyttar nu post ' Nr ' av ' Postant : Nr=Nr+1
5280 ISAM READ #1,I$ FIRST 
5290 I$=LEFT$(I$,Position-1)+SPACE$(Skillnad)+RIGHT$(I$,Position)
5295 ISAM WRITE #2,I$
5300 FOR I=1 TO Postant-1
5305   PRINT CUR(10,0) 'Jag flyttar nu post ' Nr ' av ' Postant : Nr=Nr+1
5310   ISAM READ #1,I$ NEXT 
5320   I$=LEFT$(I$,Position-1)+SPACE$(Skillnad)+RIGHT$(I$,Position)
5330   ISAM WRITE #2,I$
5340 NEXT I 
5345 CLOSE ! st{ng alla filer
5350 ! 
5360 ! {ndra drivenummer
5370 CLOSE 
5380 ON ERROR GOTO 5490
5390 OPEN 'DR0:DATA.ISM' AS FILE 1
5400 POSIT #1,1
5410 GET #1,Temp$
5420 Temp=ASCII(Temp$)
5430 Temp=Temp+1
5440 Temp$=CHR$(Temp)
5450 POSIT #1,1
5460 PUT #1,Temp$
5470 CLOSE : GOTO 5510
5480 ! 
5490 PRINT FNSudda$
5492 PRINT CUR(5,0) 'FEL nummer: ' ERRCODE
5495 P$=FNInp$(CUR(8,0)+'Tryck p} Return. ',1)
5500 ! 
5510 PRINT FNSudda$
5520 P$=FNInp$(CUR(5,0)+'Vill du radera dataskivan i DR1:  (J/N) ',1)
5530 P$=FNConv$(P$)
5540 IF P$='N' THEN 5640
5550 IF P$<>'J' THEN 5520
5560 P$=FNInp$(CUR(8,0)+'ABSOLUT s{ker (J/N) ???????????? ',1)
5570 P$=FNConv$(P$)
5580 IF P$='N' THEN 5640
5590 IF P$<>'J' THEN 5520
5600 KILL 'DR1:DATA.ID'
5610 KILL 'DR1:DATA.ISM'
5620 KILL 'DR1:DATA.DAT'
5630 KILL 'DR1:PRINTER.DAT'
5640 PRINT FNSudda$
5650 PRINT CUR(5,0) 'S{tt i PROGRAM-skivan i DR0: /v{nstra luckan/'
5660 PRINT 'Tryck sedan p} en Return.'
5670 PRINT 'OBS! v{nta till lysdioden har slocknat.'
5680 ON ERROR GOTO 5730
5690 P$=FNInp$(CUR(9,0)+'',1)
5700 CHAIN 'MENY'
5710 ! 
5720 ! 
5730 PRINT Sudda$
5740 PRINT CUR(5,0) 'Har du verkligen satt i PROGRAM-skivan i v{nstra driven?'
5750 PRINT 'Se efter n{r den r|da lysdioden har slocknat.'
5760 PRINT 'Tryck sedan p} en Return. '
5765 P$=FNInp$(CUR(9,0)+'',1)
5770 GOTO 5680
5780 PRINT FNSudda$
5790 CLOSE 
5800 PRINT CUR(5,0) 'FEL nummer ' ERRCODE ' vid |verf|ring av DATA fil.'
5810 P$=FNInp$(CUR(8,0)+'Tryck p} Return. ',1)
5820 ! 
5830 ! =================================================================