1 REM Ins{nd av Erik Wetterberg <5948>  1987-01-21 Diskett
2 ! 
10 ! LIST MEDLCRE.BAS
20 ! ----- CREISAM --------
21 ! ! Anv{nds f|r att skapa en ISAM-fil och f|r att l{sa strukturen 
22 ! ! i befintliga s}dana.
30 ! 
40 ! utvecklat p} Facit DTC 2
50 ! anpassat (efter b{sta f|rm}ga) till ABC806
60 ! anpassning till andra datorer kan g|ras i FNInittang
70 ! Erik Wetterberg <5948>
80 ! 
90 ! VARNING: OM DU L[SER IN EN ISAM-FIL OCH SEDAN ]TERSKRIVER
95 ! DEN MED DETTA PROGRAM F\RST\RS ALLA DATA I FILEN !!!!!
100 ! --------------------------------------
101 ! Rev 19870314.1838 Bengt Sandgren <2776>:
102 ! Namn{ndrat f|r anpassning till programpaketet
103 ! CHAIN "NUL:" borttaget p} rad 2050.
104 ! Rev 19870627 Kristoffer Eriksson <5357>:
105 ! Rad 1890 {ndrad f|r tangentkoder p} alla ABC80x
106 ! Rad 400, 405, 409 {ndrade f|r att sl{cka rad 25 vid END
107 ! Rad 1780 felaktiga flyttal bort
108 ! Rad 1920 upplyser att PF8=Del
109 ! Rad 1785,1790 undviker BLK p} ABC800 som saknar den
110 ! Rad 125 f|r r{tt inladdning fr}n BAS-form
120 ! -----------------------------------------------------
125 INTEGER : EXTEND 
130 Ret$=CHR$(13) : Del$=CHR$(8) : Linedel$=CHR$(24)
140 Fram$=CHR$(163) : Back$=CHR$(162)
150 True=(1=1)
160 DIM Filnamn$=8,Filtyp$=3,Indnamn$(1:10)=8,Dupl$(1:10)=1,Typ$(1:10)=1
170 DIM Inlen(1:10),Start(1:10)
180 DIM Indfil$=8,Indtyp$=3
190 Indfil$=SPACE$(8) : Indtyp$="ISM"
200 Filnamn$=SPACE$(8) : Filtyp$="ISD"
210 FOR Indnr=1 TO 10
220   Indnamn$(Indnr)=SPACE$(8) : Dupl$(Indnr)="N" : Typ$(Indnr)="A"
230 NEXT Indnr 
240 PRINT CHR$(12)
250 PRINT CUR(2,0) "INDEXFIL:" CUR(2,18) "." CUR(2,24) "DATAFIL:" CUR(2,41) ".";
260 PRINT CUR(2,47) "POSTL[NGD:" CUR(2,64) "ANTAL INDEX:";
270 PRINT CUR(4,0) "INDEX" CUR(4,10) "DUBL" CUR(4,16) "START";
280 PRINT CUR(4,22) "L[NGD" CUR(4,28) "TYP";
290 Z=FNInittang
300 PRINT CUR(23,0);
310 GET Kom$
320 ! ------------------- HUVUDSLINGA ---------------
330 WHILE Kom$<>Esc$
340   IF Kom$=Pf$(1) THEN Z=FNEditis
350   IF Kom$=Pf$(2) THEN Z=FNSaveis
360   IF Kom$=Pf$(3) THEN Z=FNReadis
370   PRINT CUR(23,0);
380   GET Kom$
390 WEND 
400 IF PEEK(39)=10 OR PEEK(39)=3 THEN OUT 56,6,57,25 ! ABC800,802
405 ; CHR$(12); : Rad25$=SPACE$(80)
409 END 
410 DEF FNSaveis LOCAL Indexfil$=12,Datafil$=12,Lxsize,Ldsize
420   PRINT CUR(20,0) "INDEXFIL STORLEK:";
430   PRINT CUR(20,30) "DATAFIL STORLEK:";
440   Lxsize=FNTalflt(Indant+1,20,19,Indant+1,64)
450   Ldsize=FNTalflt(1,20,49,1,2048)
460   Indexfil$=FNNoblank$(Indfil$+"."+Indtyp$)
470   Datafil$=FNNoblank$(Filnamn$+"."+Filtyp$)
480   PREPARE Datafil$ AS FILE 1 : PUT #1,STRING$(Ldsize*253,0) : CLOSE 1
490   PREPARE Indexfil$ AS FILE 1
500   PUT #1,CHR$(1,255) ! isam-version, alla drivar
510   PUT #1,Filnamn$+Filtyp$
520   PUT #1,CHR$(3) ! delimiter
530   PUT #1,CVT%$(Indant+1)
540   PUT #1,STRING$(9,0) ! f|r framtida bruk pos 17-25
550   PUT #1,CVT%$(Postlen)
560   FOR Indnr=1 TO Indant
570     PUT #1,Indnamn$(Indnr)+CHR$(3)
580     PUT #1,CVT%$(Indnr)
590     IF Dupl$(Indnr)="J" THEN PUT #1,CHR$(1) ELSE PUT #1,CHR$(0)
600     PUT #1,CVT%$(Start(Indnr))
610     PUT #1,CHR$(Inlen(Indnr))
620     PUT #1,CHR$(INSTR(1,"BAIFD",Typ$(Indnr))-1)
630     PUT #1,STRING$(4,0) ! f|r framtida bruk pos 44-47
640   NEXT Indnr 
650   PUT #1,STRING$(253*Lxsize-POSIT(1),0)
660   CLOSE 1
670   RETURN 0
680 FNEND 
690 ! ------------------------------
700 DEF FNEditis LOCAL Indnr
710   Indfil$=FNTxtflt$(Indfil$,2,10)
720   Indtyp$=FNTxtflt$(Indtyp$,2,19)
730   IF Filnamn$=SPACE$(8) THEN Filnamn$=Indfil$
740   Filnamn$=FNTxtflt$(Filnamn$,2,33)
750   Filtyp$=FNTxtflt$(Filtyp$,2,42)
760   Postlen=FNTalflt(Postlen,2,58,4,512)
770   Indant=FNTalflt(Indant,2,77,0,10)
780   Indnr=1
790   WHILE Indnr<=Indant
800     Indnamn$(Indnr)=FNTxtflt$(Indnamn$(Indnr),4+Indnr,0)
810     Dupl$(Indnr)=FNValflt$(Dupl$(Indnr),"JN",4+Indnr,10)
820     Start(Indnr)=FNTalflt(Start(Indnr),4+Indnr,16,1,Postlen)
830     Inlen(Indnr)=FNTalflt(Inlen(Indnr),4+Indnr,22,1,Postlen-Start(Indnr)+1)
840     Typ$(Indnr)=FNValflt$(Typ$(Indnr),"BAIFD",4+Indnr,28)
850     Indnr=Indnr+1
860   WEND 
870   RETURN 0
880 FNEND 
890 ! ---------------------------------
900 DEF FNReadis LOCAL Indnr
910   ON ERROR GOTO 1280
920   Indfil$=FNTxtflt$(Indfil$,2,10)
930   Indtyp$=FNTxtflt$(Indtyp$,2,19)
940   Indexfil$=FNNoblank$(Indfil$+"."+Indtyp$)
950   OPEN Indexfil$ AS FILE 1
960   GET #1,Buff$ COUNT 2
970   IF ASCII(Buff$)<>1 THEN RETURN FNErr("Felaktig ISAM-version: "+NUM$(ASCII(Buff$)))
980   GET #1,Filnamn$ COUNT 8 : GET #1,Filtyp$ COUNT 3
990   PRINT CUR(2,33) Filnamn$ CUR(2,42) Filtyp$;
1000   GET #1,Buff$ COUNT 1 ! delimiter chr$(3)
1010   GET #1,Buff$ COUNT 2
1020   GET #1,Buff$ COUNT 9 ! f|r framtida bruk pos 17-25
1030   GET #1,Buff$ COUNT 2 : Postlen=CVT$%(Buff$)
1040   PRINT CUR(2,57) Postlen;
1050   Indnr=1
1060   WHILE 1
1070     GET #1,Indnamn$(Indnr) COUNT 8
1080     GET #1,Buff$ COUNT 1 : IF Buff$<>CHR$(3) GOTO 1210
1090     GET #1,Buff$ COUNT 2
1100     GET #1,Buff$ COUNT 1 : IF Buff$=CHR$(1) THEN Dupl$(Indnr)="J" ELSE Dupl$(Indnr)="N"
1110     GET #1,Buff$ COUNT 2 : Start(Indnr)=CVT$%(Buff$)
1120     GET #1,Buff$ COUNT 1 : Inlen(Indnr)=ASCII(Buff$)
1130     GET #1,Buff$ COUNT 1 : Typ$(Indnr)=MID$("BAIFD",ASCII(Buff$)+1,1)
1140     GET #1,Buff$ COUNT 4 ! f|r framtida bruk pos 44-47
1150     PRINT CUR(4+Indnr,0) SPACE$(40);
1160     PRINT CUR(4+Indnr,0) Indnamn$(Indnr) CUR(4+Indnr,10) Dupl$(Indnr);
1170     PRINT CUR(4+Indnr,15) Start(Indnr) CUR(4+Indnr,21) Inlen(Indnr);
1180     PRINT CUR(4+Indnr,28) Typ$(Indnr);
1190     Indnr=Indnr+1
1200   WEND 
1210   Indant=Indnr-1 : PRINT CUR(2,76) Indant;
1220   WHILE Indnr<=10
1230     PRINT CUR(4+Indnr,0) SPACE$(40);
1240     Indnr=Indnr+1
1250   WEND 
1260   CLOSE 1
1270   RETURN 0
1280   IF ERRCODE=21 THEN RESUME 1300
1290   PRINT " Errcode: " ERRCODE : STOP 
1300   RETURN FNErr("Hittar ej filen !")
1310 FNEND 
1320 DEF FNTxtflt$(In$,Inrad,Inkol) LOCAL Lch$=1,Lnr,Ltxt$=80
1330   ! inl{sning av en textstr{ng
1340   Ltxt$=SPACE$(80)
1350   MID$(Ltxt$,1,LEN(In$))=In$
1360   Lnr=1
1370   PRINT CUR(Inrad,Inkol) MID$(Ltxt$,1,LEN(In$));
1380   PRINT CUR(Inrad,Inkol+Lnr-1);
1390   GET Lch$
1400   IF Lch$=Ret$ THEN RETURN MID$(Ltxt$,1,LEN(In$))
1410   IF Lch$=Del$ AND Lnr>1 THEN MID$(Ltxt$,Lnr-1,81-Lnr)=RIGHT$(Ltxt$,Lnr) : Lnr=Lnr-1 : GOTO 1370
1420   IF Lch$=Linedel$ THEN MID$(Ltxt$,1,LEN(In$))=SPACE$(LEN(In$)) : Lnr=1 : GOTO 1370
1430   IF Lch$=Back$ AND Lnr>1 THEN Lnr=Lnr-1 : GOTO 1380
1440   IF Lch$=Fram$ AND Lnr<LEN(In$) THEN Lnr=Lnr+1 : GOTO 1380
1450   IF ASCII(Lch$)<32 OR ASCII(Lch$)>126 THEN PRINT CHR$(7); : GOTO 1390
1460   IF Lnr>LEN(In$) THEN PRINT CHR$(7); : GOTO 1390
1470   IF Lch$>CHR$(95) THEN Lch$=CHR$(ASCII(Lch$) AND NOT 32)
1480   PRINT Lch$; : MID$(Ltxt$,Lnr,1)=Lch$
1490   Lnr=Lnr+1 : GOTO 1390
1500 FNEND 
1510 DEF FNValflt$(In$,Inalt$,Inrad,Inkol) LOCAL Lch$=1,Lsv$=1
1520   Lsv$=In$
1530   WHILE True
1540     PRINT CUR(Inrad,Inkol) Lsv$;
1550     PRINT CUR(Inrad,Inkol);
1560     GET Lch$
1570     IF Lch$=Ret$ THEN RETURN Lsv$
1580     IF Lch$>CHR$(95) THEN Lch$=CHR$(ASCII(Lch$) AND NOT 32)
1590     IF INSTR(1,Inalt$,Lch$)=0 THEN Z=FNErr("Ange n}got av "+Inalt$+" !") ELSE Lsv$=Lch$
1600   WEND 
1610 FNEND 
1620 ! 
1630 DEF FNTalflt(In,Inrad,Inkol,Inmin,Inmax) LOCAL Ltxt$=5,Llen,Ltal
1640   ! inl{sning av ett heltal
1650   ON ERROR GOTO 1730
1660   Llen=LEN(NUM$(Inmax))
1670   IF LEN(NUM$(Inmin))>Llen THEN Llen=LEN(NUM$(Inmin))
1680   Ltxt$=FNTxtflt$(NUM$(In)+SPACE$(Llen-LEN(NUM$(In))),Inrad,Inkol)
1690   IF Ltxt$=SPACE$(Llen) THEN Ltal=0 ELSE Ltal=VAL(Ltxt$)
1700   IF Ltal>Inmax OR Ltal<Inmin THEN Z=FNErr("Ange tal mellan "+NUM$(Inmin)+" och "+NUM$(Inmax)+" !") : GOTO 1680
1710   RETURN Ltal
1720   ! ------- felhantering fnreadtal --------
1730   IF ERRCODE=210 THEN PRINT CHR$(7) : RESUME 1680
1740   PRINT " ** FNTalflt Errcode: " ERRCODE : STOP 
1750 FNEND 
1760 ! 
1770 DEF FNErr(In$) LOCAL Rad,Kol
1780   Rad=PEEK(65363) : Kol=PEEK(65362)
1785   PRINT CHR$(7) CUR(0,40); : IF PEEK(39)<>10 THEN PRINT WHT NWBG Blk;
1790   PRINT In$ BLBG WHT CUR(Rad,Kol);
1800   RETURN 0
1810 FNEND 
1820 ! 
1830 DEF FNInittang
1840   DIM Rad25$=0 : POKE VAROOT(Rad25$),0,80,32640,SWAP%(32640),0,80
1850   DIM Esc$=1,Ret$=1,Del$=1,Linedel$=1,Fram$=1,Back$=1
1860   DIM Pf$(1:14)=1
1870   Pf$(1)=CHR$(192) : Pf$(2)=CHR$(193) : Pf$(3)=CHR$(194) : Pf$(4)=CHR$(195)
1880   Pf$(5)=CHR$(196) : Pf$(6)=CHR$(197) : Pf$(7)=CHR$(198) : Pf$(8)=CHR$(199)
1890   IF PEEK(39)<>3 AND PEEK(39)<>4 AND PEEK(39)<>10 THEN GOTO 1970
1900   ! ----- tangentkoder ABC 80x ----------------
1910   OUT 56,6,57,25
1920   Rad25$="PF1:[ndra  PF2:Spara PF3:L{s in PF6:Avsluta (PF8:Radera tecken)"
1930   Esc$=CHR$(197) : Ret$=CHR$(13)
1940   Del$=CHR$(199) : Linedel$=CHR$(24)
1950   Fram$=CHR$(9) : Back$=CHR$(8)
1960   RETURN 0
1970   IF PEEK(39)<>6 THEN GOTO 2040
1980   ! ----- tangentkoder Facit DTC 2 ------------
1990   Rad25$="PF1:[ndra  PF2:Spara PF3:L{s in Esc:Avsluta"
2000   Esc$=CHR$(27) : Ret$=CHR$(13)
2010   Del$=CHR$(8) : Linedel$=CHR$(24)
2020   Fram$=CHR$(163) : Back$=CHR$(162)
2030   RETURN 0
2040   PRINT CHR$(12)+"Programmet ej anpassat f|r denna dator"+CHR$(7)
2050   RETURN 0 ! CHAIN "NUL:"
2060 FNEND 
2070 ! ------------------------------------------------
2080 DEF FNNoblank$(In$) LOCAL Pos
2090   Pos=INSTR(1,In$," ")
2100   IF Pos=0 RETURN In$
2110   RETURN LEFT$(In$,Pos-1)+FNNoblank$(RIGHT$(In$,Pos+1))
2120 FNEND