10 ! LIST MEDCRE.BAS 20 ! +-------------------------------- 30 ! ! MEDCRE 1.0 - Skapa ISAM-registren f|r MEDLEM.BAS 40 ! ! F|r ABC800-serien, med disk och ISAM. 50 ! ! Av Kristoffer Eriksson <5357>, 1987-09-06 60 ! ! Fri kopiering f|r ickekommersiella syften till}ten. 65 ! ! Denna fil ers{tter MEDLCRE.BAS 70 ! +-------------------------------- 80 ! Skapa register 90 ! 100 ! DATA: Antal index, Postl{ngd, 110 ! . Indexnamn, Duplicerade nycklar?, Startpos, L{ngd, Typ ... 120 ! Typer B=Bin{rt, A=ASCII, I=Integer, F=Float Single, D=Float Double, C=BCD 130 ! (0=Bin{rt, 1=ASCII, 2=Integer, 3=Float Single, 4=Float Double, 5=BCD) 140 ! Duplicerade nycklar: D och J betyder Ja, allt annat ({ven tom) Nej. 150 ! 160 ! 170 EXTEND 180 INTEGER 190 Dv$="" 200 ! IF Chain$="" THEN LET Chain$="MEDLEM" 210 ; CHR$(12) 'Skapa register till "MEDLEM"' 220 ; STRING$(80,ASCII("-")) : ; 230 INPUT "F|reningsnamn (max 4 tecken): ";F|r$ 240 IF F|r$="" THEN STOP 250 IF LEN(F|r$)-INSTR(1,F|r$,":")>4 THEN ; "F|r l}ngt." : GOTO 230 260 ! 270 ! *** xxxxMEDL 280 ! F{ltnamn Typ Startpos, L{ngd som index, Verklig l{ngd i posten 290 ! --------------------------------------------------------------------- 300 ! Lisamfyllnad B 1 - 3 310 ! MEDLNR I 4 2 2 320 ! PERSNR1 A 6 - 6 330 ! PERSNR2 A 12 - 4 340 ! MNAMN A 16 4 30 350 ! COADR A 46 - 30 360 ! ADR A 76 - 30 370 ! POSTNR A 106 5 5 380 ! PADR A 111 - 16 390 ! TELE A 127 - 10 400 ! Summa: 136 bytes 410 ! --- 420 ! 430 DATA 3, 136 440 DATA MEDLNR, N, 4, 2, I 450 DATA MNAMN, J, 16, 4, A 460 DATA POSTNR, J,106, 5, A 470 ! 480 RESTORE 430 490 Z=FNMakeit(F|r$+"MEDL","Medlemsregistret",0) 500 ! 510 ! 520 ! 530 ! *** xxxxMKOD 540 ! F{ltnamn Typ Startpos, L{ngd som index, Verklig l{ngd i posten 550 ! --------------------------------------------------------------------- 560 ! Lisamfyllnad B 1 - 3 570 ! MEDLNR I 4 2 2 580 ! MKOD A 6 6 6 590 ! MNRKOD B 4 8 - 600 ! DATKOD A 12 - 6 610 ! Summa: 17 bytes 620 ! --- 630 ! 640 DATA 3, 17 650 DATA MEDLNR, J, 4, 2, I 660 DATA MKOD, J, 6, 6, A 670 DATA MNRKOD, J, 4, 8, B 680 ! 690 RESTORE 640 700 Z=FNMakeit(F|r$+"MKOD","Till{ggskodsregistret",0) 710 ! 720 ! 730 ! 740 ! --- 750 ! 760 ; "Klart." 770 I=0 : WHILE I<700 AND SYS(5)<128 780 I=I+1 790 WEND 800 IF SYS(5)>127 THEN GET I$ 810 ! 820 WHILE LEN(Chain$) 830 ! ON ERROR GOTO 1110 : CHAIN "RAM:"+Chain$ 840 ON ERROR GOTO 850 : CHAIN Chain$ 850 ; RED NWBG YEL CHR$(7) "> Hittar inte programmet '" Chain$ "' <" BLBG 860 IF ERRCODE<>21 THEN ; "( Felkod" ERRCODE ")" 870 ; "Tryck p} CE..."; 880 I$="" : WHILE I$<>CHR$(24) : GET I$ : WEND 890 WEND 900 ! ON ERROR GOTO 800 : CHAIN "XS0" 910 END 920 ! 930 ! 940 ! 950 DEF FNFel(N,Typ) LOCAL Gt$=1 960 ; CHR$(7) RED NWBG YEL "> "; 970 IF Typ=1 THEN ; FNBasicfel$(N); : GOTO 990 980 ON N GOSUB 1020 990 ; " <" BLBG 1000 GET Gt$ 1010 RETURN N OR SWAP%(Typ) 1020 ; ; : RETURN 1030 FNEND 1040 ! 1050 DEF FNBasicfel$(X) 1060 IF X=21 THEN RETURN "Filen finns ej" 1070 IF X=22 THEN RETURN "Biblioteket finns ej" 1080 IF X=48 THEN RETURN "Fel i biblioteket" 1090 IF X=35 THEN RETURN "Kontrollsummafel vid l{sning" 1100 IF X=36 THEN RETURN "Kontrollsummafel vid skrivning." 1110 IF X=39 THEN RETURN "Filen skrivskyddad" 1120 IF X=40 THEN RETURN "Filen l{sskyddad" 1130 IF X=41 THEN RETURN "Skivan {r full" 1140 IF X=42 THEN RETURN "Enheten ej klar" 1150 IF X=43 THEN RETURN "Skivan skrivskyddad" 1160 IF X=46 THEN RETURN "Biblioteket ej inst{llt" 1170 IF X=52 THEN RETURN "G}r inte p} denna enhet" 1180 IF X=51 THEN RETURN "Enheten upptagen" 1190 RETURN "Felkod "+NUM$(X) 1200 FNEND 1210 ! 1220 DEF FNChmod(Dv,Fil$,Stat) 1230 RETURN 0 ! Strunta i chmod 1430 FNEND 1440 ! 1450 DEF FNPrep(F$,T$) LOCAL I$=160 1460 ; T$ 1470 ON ERROR GOTO 1590 1480 OPEN Dv$+F$+".ISM" AS FILE 1 : OPEN Dv$+F$+".ISD" AS FILE 2 1490 CLOSE 1500 ; CHR$(7); 1510 ; "Registret finns redan! "; 1520 ; "Ska det verkligen " Uln FLSH "raderas" STDY Nuln; 1530 ON ERROR GOTO 1510 : INPUT " J/N ? ";I$ : ON ERROR GOTO 1540 IF I$="" THEN 1510 1550 I$=CHR$(ASCII(I$) AND 95) 1560 IF I$="N" THEN ; "Registret {r kvar." : ; : RETURN -1 1570 IF I$<>"J" THEN 1500 1580 ! 1590 ON ERROR GOTO 1690 1600 ; "Registret skapas ..." CHR$(13); 1610 PREPARE Dv$+F$+".ISD" AS FILE 1 : CLOSE 1 1620 PREPARE Dv$+F$+".ISM" AS FILE 2 1630 RETURN 0 1640 ! 1650 IF ERRCODE=21 THEN 1590 1660 Z=FNFel(ERRCODE,1) 1670 GOTO 1520 1680 ! 1690 Z=FNFel(ERRCODE,1) : RETURN -1 1700 FNEND 1710 ! 1720 DEF FNIsinit(F$) LOCAL Ant,Ind,N$=8,I 1730 ON ERROR GOTO 2020 1740 PUT #2 CHR$(1) ! Isamfilversion 1750 PUT #2 CHR$(255)+F$+SPACE$(8-LEN(F$))+"ISD"+CHR$(3) 1760 READ Ant 1770 PUT #2 CVT%$(Ant+1) ! Antal index + 1 1780 PUT #2 STRING$(9,0) 1790 READ I 1800 PUT #2 CVT%$(I) ! Postl{ngd 1810 Ind=1 1820 WHILE Ind<=Ant 1830 READ N$ 1840 PUT #2 N$+SPACE$(8-LEN(N$))+CHR$(3) ! Indexnamn 1850 PUT #2 CVT%$(Ind) ! Indexnr 1860 READ N$ 1870 I=0 : IF LEN(N$) THEN I=INSTR(1,"DdJj",N$) AND 1 1880 PUT #2 CHR$(I) ! Duplicerade nycklar till}tna? 1890 READ I 1900 PUT #2 CVT%$(I) ! Startpos i post 1910 READ I 1920 PUT #2 CHR$(I) ! L{ngd p} index 1930 READ N$ 1940 I=INSTR(1,"BAIFDC",N$)-1 ! Bin, ASC, Int, Float singel, Double, BCD 1950 PUT #2 CHR$(I) ! Typ 1960 PUT #2 CHR$(0,0,0,0) 1970 Ind=Ind+1 1980 WEND 1990 PUT #2 STRING$(2530+253-MOD(POSIT(2),253),0) 2000 CLOSE 2010 RETURN 0 2020 Z=FNFel(ERRCODE,1) 2030 CLOSE : RETURN -1 2040 FNEND 2050 ! 2060 DEF FNIschmod(F$,Stat) 2070 IF (PEEK(24688) AND 254)<>8 THEN RETURN 0 2080 Z=FNChmod(255,F$+".ISM",Stat) 2090 Z=FNChmod(255,F$+".ISD",Stat) 2100 RETURN 0 2110 FNEND 2120 ! 2130 DEF FNMakeit(F$,T$,Stat) 2140 IF FNPrep(F$,T$) THEN RETURN -1 2150 IF FNIsinit(F$) THEN RETURN -1 2160 Z=FNIschmod(F$,Stat) 2170 ; "Registret {r nu skapat." : ; 2180 RETURN 0 2190 FNEND