1 REM Ins{nd av Erik Wetterberg <5948> 1987-01-21 Diskett
2 !
10 ! LIST MEDLEM.BAS
11 ! -------------- MEDLEM ---------------
20 ! hantering av medlemregister
30 ! anv{nder ISAM-filer, som m}ste skapas f|rst
40 ! Isam m}ste vara laddat
41 ! INFO i MEDLEM.INF
50 !
60 ! utvecklat p} Facit DTC 2
70 ! anpassat (n}gorlunda) till ABC806 - men det
80 ! {r sv}rt med bristen p} mark|rflyttningstangenter
90 ! {ndra g{rna i FNInittang, d{r du ocks} kan anpassa
100 ! programmet f|r andra ABC-datorer
110 ! Erik Wetterberg <5948>
111 ! -----------------------------------------
112 ! Kristoffer Eriksson <5357> 870627:
113 ! Rad 2800, 2810 {ndrade f|r {ven ABC 800M och 802,
114 ! Rad 2850 Del {ndrad till CTRL-D
115 ! Rad 575 underl{ttar omstart.
116 ! Rad 576,577 sl{cker rad 25
117 ! Rad 755,865 hindrad error vid s|kning i tomt register
118 ! Rad 1025,1026,1045, 1135,1140,1165 (1130 {ndrad) tar hand om Error 120
119 ! vid stegning i tomt register och efter s|kning av obefintlig post n{r en
120 ! raderad post visas. Kan g|ras p} flera andra s{tt som kanske skulle vara
121 ! mer konsekventa. Stegning kunde t ex sp{rras i dessa l{gen, och FIRST och
122 ! LAST kunda man ha som s{rskilda funktioner.
123 ! Rad 1480 {ndrad s} medlemsnr inte skrivs dubbelt
124 ! Rad 2685,2690 undviker BLK p} ABC800 som saknar den
125 ! Rad 135 f|r r{tt inladdning i BAS-form
128 !
130 ! -----------------------------------------
135 INTEGER : EXTEND
140 COMMON Klubb$=4
150 DIM Medlpost$=136 : Medlpost$=CHR$(255,255,255)+SPACE$(133)
160 DIM Persnr$=11,Mnamn$=0,Coadr$=0,Adr$=0,Postnr$=0,Padr$=0,Tele$=0,Fill255$=0
170 Adr=VARPTR(Medlpost$)
180 POKE VAROOT(Fill255$),3,0,Adr,SWAP%(Adr),3,0
190 POKE VAROOT(Mnamn$),30,0,Adr+15,SWAP%(Adr+15),30,0
200 POKE VAROOT(Coadr$),30,0,Adr+45,SWAP%(Adr+45),30,0
210 POKE VAROOT(Adr$),30,0,Adr+75,SWAP%(Adr+75),30,0
220 POKE VAROOT(Postnr$),5,0,Adr+105,SWAP%(Adr+105),5,0
230 POKE VAROOT(Padr$),16,0,Adr+110,SWAP%(Adr+110),16,0
240 POKE VAROOT(Tele$),10,0,Adr+126,SWAP%(Adr+126),10,0
250 DIM Mkodpost$=17,Mkod$=0,Datkod$=0
260 Adr=VARPTR(Mkodpost$)
270 POKE VAROOT(Mkod$),6,0,Adr+5,SWAP%(Adr+5),6,0
280 POKE VAROOT(Datkod$),6,0,Adr+11,SWAP%(Adr+11),6,0
290 True=(1=1)
300 PRINT CHR$(12)
310 Z=FNInittang
320 IF Klubb$<>SPACE$(LEN(Klubb$)) THEN GOTO 340
330 Klubb$=FNIntxt$("MEDLEMSREGISTER F\R: ",SPACE$(4))
340 IF NOT FNInitfile(Klubb$) THEN Z=FNErr("Inget s}dant register !!") : GOTO 330
350 PRINT CUR(2,0) Klubb$ " MEDLEMSREGISTER";
360 PRINT CUR(4,0) "NAMN:" CUR(4,40) "PERSNR:" CUR(4,60) "MEDLNR:";
370 PRINT CUR(6,0) "CO:" CUR(6,40) "TEL:";
380 PRINT CUR(8,0) "ADR:" CUR(8,40) "POSTNR:" CUR(8,54) "POSTADR:";
390 Z=FNVisa
400 PRINT CUR(23,0);
410 GET Kom$
420 ! ------------------- HUVUDSLINGA ---------------
430 WHILE Kom$<>Esc$
440 IF Kom$=Pf$(1) THEN Z=FNSoekmedl
450 IF Kom$=Pf$(2) THEN Z=FNSoeknamn
460 IF Kom$=Pf$(4) THEN Z=FNSkapa(NOT True)
470 IF Kom$=Pf$(5) THEN Z=FNSkapa(True)
480 IF Kom$=Pf$(6) THEN Z=FNMkodupd
490 IF Kom$=Pf$(7) THEN Z=FNDele
500 IF Kom$=Pf$(8) THEN CHAIN "medlskrv"
510 IF Kom$=Fram$ THEN Z=FNFram("MNAMN")
520 IF Kom$=Back$ THEN Z=FNBack("MNAMN")
530 IF Kom$=Sfram$ THEN Z=FNFram("MEDLNR")
540 IF Kom$=Sback$ THEN Z=FNBack("MEDLNR")
550 PRINT CUR(23,0);
560 GET Kom$
570 WEND
575 Klubb$=""
576 IF PEEK(39)=10 OR PEEK(39)=3 THEN OUT 56,6,57,25 ! ABC800,802
577 Rad25$=SPACE$(80)
580 END
590 ! ------------------------------
600 DEF FNInitfile(In$) LOCAL Fil$=12
610 ON ERROR GOTO 710
620 Fil$=FNNoblank$(In$+"medl.ism")
630 ISAM OPEN Fil$ AS FILE 1
640 Fil$=FNNoblank$(In$+"mkod.ism")
650 ISAM OPEN Fil$ AS FILE 2
660 Aktind$="MEDLNR"
670 ISAM READ #1,Medlpost$ INDEX "MEDLNR" LAST
680 Medlnrmax=CVT$%(MID$(Medlpost$,4,2))
690 RETURN True
700 RETURN NOT True
710 IF ERRCODE=34 THEN Medlnrmax=0 : RESUME 690
720 RESUME 700
730 FNEND
740 ! --------------
750 DEF FNSoekmedl LOCAL Medlnr
755 IF Medlnrmax=0 THEN RETURN FNErr("Tomt register!")
760 Aktind$="MEDLNR"
770 ON ERROR GOTO 820
780 Medlnr=FNIntal("Medlem nr: ",CVT$%(MID$(Medlpost$,4,2)),1,Medlnrmax)
790 ISAM READ #1,Medlpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr)
800 RETURN FNVisa
810 RETURN FNErr("Hittar ej medlem nr "+NUM$(Medlnr)+" !")
820 IF ERRCODE=120 THEN RESUME 810
830 PRINT "** FNSoekmedl error: " ERRCODE : STOP
840 FNEND
850 ! ---------------------------------
860 DEF FNSoeknamn LOCAL Lnamn$=4
865 IF Medlnrmax=0 THEN RETURN FNErr("Tomt register!")
870 Aktind$="MNAMN"
880 ON ERROR GOTO 930
890 Lnamn$=FNIntxt$("Namn: ",LEFT$(Mnamn$,4))
900 ISAM READ #1,Medlpost$ INDEX "MNAMN" KEY Lnamn$
910 RETURN FNVisa
920 RETURN FNErr("Hittar ej medlem "+Lnamn$+" !")
930 IF ERRCODE=120 THEN RESUME 920
940 PRINT "** FNSoeknamn error: " ERRCODE : STOP
950 FNEND
960 ! ---------------------------------
970 DEF FNFram(In$) LOCAL Lkey$=4
980 ON ERROR GOTO 1040
990 IF In$=Aktind$ THEN GOTO 1020
1000 IF In$="MNAMN" THEN Lkey$=LEFT$(Mnamn$,4) ELSE Lkey$=MID$(Medlpost$,4,2)
1010 ISAM READ #1,Medlpost$ INDEX In$ KEY Lkey$ : Aktind$=In$
1020 ISAM READ #1,Medlpost$ INDEX In$ NEXT : RETURN FNVisa
1025 ISAM READ #1,Medlpost$ INDEX In$ FIRST : RETURN FNVisa
1026 !
1030 RETURN FNErr("Inga fler medlemmar !!")
1040 IF ERRCODE=34 THEN RESUME 1030
1045 IF ERRCODE=120 THEN RESUME 1025
1050 PRINT "** FNFram error: " ERRCODE : STOP
1060 FNEND
1070 ! ----------------------------------
1080 DEF FNBack(In$) LOCAL Lkey$=4
1090 ON ERROR GOTO 1160
1100 IF In$=Aktind$ THEN GOTO 1130
1110 IF In$="MNAMN" THEN Lkey$=LEFT$(Mnamn$,4) ELSE Lkey$=MID$(Medlpost$,4,2)
1120 ISAM READ #1,Medlpost$ INDEX In$ KEY Lkey$ : Aktind$=In$
1130 ISAM READ #1,Medlpost$ INDEX In$ PREVIOUS : RETURN FNVisa
1135 ISAM READ #1,Medlpost$ INDEX In$ LAST : RETURN FNVisa
1140 !
1150 RETURN FNErr("Inga fler medlemmar !!")
1160 IF ERRCODE=34 THEN RESUME 1150
1165 IF ERRCODE=120 THEN RESUME 1135
1170 PRINT "** FNBack error: " ERRCODE : STOP
1180 FNEND
1190 ! -----------------------------------
1200 DEF FNVisa
1210 ON ERROR GOTO 1390
1220 Persnr$=MID$(Medlpost$,6,6)+"-"+MID$(Medlpost$,12,4)
1230 IF Medlnrmax=0 THEN Medlnr=0 ELSE Medlnr=CVT$%(MID$(Medlpost$,4,2))
1240 ! ----------------
1250 PRINT CUR(4,6) Mnamn$ CUR(4,48) Persnr$ CUR(4,68);
1260 PRINT USING "#####" Medlnr;
1270 PRINT CUR(6,6) Coadr$ CUR(6,48) Tele$;
1280 PRINT CUR(8,6) Adr$ CUR(8,48) Postnr$ CUR(8,62) Padr$;
1290 Rad=10 : Kol=0 : Eof=NOT True
1300 PRINT FNBlankkod$;
1310 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr)
1320 WHILE NOT Eof AND Medlnr=CVT$%(MID$(Mkodpost$,4,2))
1330 PRINT CUR(Rad,Kol) Mkod$ " " Datkod$;
1340 Rad=Rad+1
1350 IF Rad>20 THEN Kol=Kol+15 : Rad=10
1360 ISAM READ #2,Mkodpost$ NEXT
1370 WEND
1380 RETURN FNMsg("")
1390 IF ERRCODE=34 OR ERRCODE=120 THEN Eof=True : RESUME 1380
1400 PRINT "FNVisa error: " ERRCODE : STOP
1410 FNEND
1420 ! ---------------------------------
1430 DEF FNBlankkod$=CUR(10,0)+SPACE$(1120)
1440 ! ---------------------------------
1450 DEF FNSkapa(Inny)
1460 ON ERROR GOTO 1660
1470 IF Inny THEN Medlnrmax=Medlnrmax+1 : Medlnr=Medlnrmax ELSE Medlold$=Medlpost$
1480 PRINT CUR(4,68); : PRINT USING "#####" Medlnr;
1490 Fltnr=1
1500 WHILE Fltnr<=7
1510 Mnamn$=FNTxtflt$(1,Mnamn$,4,6)
1520 IF Fltnr<1 THEN PRINT CHR$(7); : Fltnr=1
1530 Persnr$=FNTxtflt$(2,MID$(Medlpost$,6,6)+"-"+MID$(Medlpost$,12,4),4,48)
1540 Coadr$=FNTxtflt$(3,Coadr$,6,6)
1550 Tele$=FNTxtflt$(4,Tele$,6,48)
1560 Adr$=FNTxtflt$(5,Adr$,8,6)
1570 Postnr$=FNTxtflt$(6,Postnr$,8,48)
1580 Padr$=FNTxtflt$(7,Padr$,8,62)
1590 WEND
1600 Fill255$=CHR$(255,255,255)
1610 MID$(Medlpost$,4,2)=CVT%$(Medlnr)
1620 MID$(Medlpost$,6,6)=MID$(Persnr$,1,6)
1630 MID$(Medlpost$,12,4)=MID$(Persnr$,8,4)
1640 IF Inny THEN ISAM WRITE #1,Medlpost$ ELSE ISAM UPDATE #1,Medlold$ TO Medlpost$
1650 RETURN FNVisa
1660 PRINT "FNSkapa error: " ERRCODE : STOP
1670 FNEND
1680 ! --------------------------------
1690 DEF FNMkodupd LOCAL Rad,Kol
1700 ON ERROR GOTO 1960
1710 Rad=10 : Kol=0
1720 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr)
1730 WHILE Medlnr=CVT$%(MID$(Mkodpost$,4,2))
1740 Mkodold$=Mkodpost$
1750 Fltnr=1
1760 WHILE Fltnr<=2
1770 Mkod$=FNTxtflt$(1,Mkod$,Rad,Kol)
1780 IF Fltnr<1 THEN PRINT CHR$(7); : Fltnr=1
1790 Datkod$=FNTxtflt$(2,Datkod$,Rad,Kol+7)
1800 WEND
1810 IF Mkod$=SPACE$(6) THEN ISAM DELETE #2,Mkodold$ ELSE IF Mkod$+Datkod$<>MID$(Mkodold$,4,12) THEN ISAM UPDATE #2,Mkodold$ TO Mkodpost$
1820 Rad=Rad+1
1830 IF Rad>20 THEN Kol=Kol+15 : Rad=10
1840 ISAM READ #2,Mkodpost$ NEXT
1850 WEND
1860 Mkodpost$=CHR$(255,255,255)+CVT%$(Medlnr)+SPACE$(12)
1870 Mkod$=FNTxtflt$(0,Mkod$,Rad,Kol)
1880 WHILE Mkod$<>SPACE$(6)
1890 Datkod$=FNTxtflt$(0,Datkod$,Rad,Kol+7)
1900 ISAM WRITE #2,Mkodpost$
1910 Rad=Rad+1
1920 IF Rad>20 THEN Kol=Kol+15 : Rad=10
1930 Mkod$=FNTxtflt$(0,Mkod$,Rad,Kol)
1940 WEND
1950 RETURN FNVisa
1960 IF ERRCODE=34 OR ERRCODE=120 THEN RESUME 1860
1970 PRINT "FNSkapa error: " ERRCODE : STOP
1980 FNEND
1990 ! ---------------------------------
2000 DEF FNDele
2010 ON ERROR GOTO 2110
2020 ISAM DELETE #1,Medlpost$
2030 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr)
2040 WHILE MID$(Mkodpost$,4,2)=CVT%$(Medlnr)
2050 ISAM DELETE #2,Mkodpost$
2060 ISAM READ #2,Mkodpost$ INDEX "MEDLNR" KEY CVT%$(Medlnr)
2070 WEND
2080 Medlpost$=CHR$(255,255,255)+CVT%$(0)+SPACE$(131)
2090 Medlnr=0
2100 RETURN FNVisa
2110 IF ERRCODE=120 OR ERRCODE=34 THEN RESUME 2080
2120 PRINT "FNDele error: " ERRCODE : STOP
2130 FNEND
2140 ! ---------------------------------
2150 DEF FNTxtflt$(Innr,In$,Inrad,Inkol) LOCAL Lch$=1,Lnr,Ltxt$=80
2160 ! inl{sning av en textstr{ng
2170 IF Innr<>Fltnr AND Innr<>0 THEN RETURN In$
2180 Ltxt$=SPACE$(80)
2190 MID$(Ltxt$,1,LEN(In$))=In$
2200 Lnr=1
2210 PRINT CUR(Inrad,Inkol) MID$(Ltxt$,1,LEN(In$));
2220 PRINT CUR(Inrad,Inkol+Lnr-1);
2230 GET Lch$
2240 IF Lch$=Ret$ THEN Fltnr=Fltnr+1 : RETURN MID$(Ltxt$,1,LEN(In$))
2250 IF Lch$=Upp$ THEN Fltnr=Fltnr-1 : RETURN MID$(Ltxt$,1,LEN(In$))
2260 IF Lch$=Quit$ THEN Fltnr=99 : RETURN MID$(Ltxt$,1,LEN(In$))
2270 IF Lch$=Del$ AND Lnr>1 THEN MID$(Ltxt$,Lnr-1,81-Lnr)=RIGHT$(Ltxt$,Lnr) : Lnr=Lnr-1 : GOTO 2210
2280 IF Lch$=Linedel$ THEN MID$(Ltxt$,1,LEN(In$))=SPACE$(LEN(In$)) : Lnr=1 : GOTO 2210
2290 IF Lch$=Back$ AND Lnr>1 THEN Lnr=Lnr-1 : GOTO 2220
2300 IF Lch$=Fram$ AND Lnr