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