1 REM Ins{nd av Jinge Fl~cht <4716>    1985-09-12 15.23.19
100 ! LIST  MO0:REGISTER.BAS
110 ! 
120 ! 
130 ! -------------------------------------------------
140 ! Programmet 'REGISTER.BAC' gjort av <4716>
150 ! Jinge Fl~cht. Programmet gjort p} ABC-802
160 ! Bara testat p} ABC-802
170 ! -------------------------------------------------
180 ! 
190 ! 
200 ! ##############################################
210 ! ##                                          ##
220 ! ##  En f|ruts{ttning f|r att f} ig}ng detta ##
230 ! ##  program {r att man f|ljer manualen i    ##
240 ! ##  REGISTER.TXT. Programmet {r en version  ##
250 ! ##  av mitt f|rsta ISAM registerprogram.    ##
260 ! ##                                          ##
270 ! ##  Programmet har 4 index, vilket {r       ##
280 ! ##  lagom mycket. Det har plats f|r 9 st    ##
290 ! ##  men det blir f|r l}ngsamt, och tar f|r  ##
300 ! ##  mycket plats p} disken. Programmet {r   ##
310 ! ##  l{mpligt f|r den som vill ha ett enkelt ##
320 ! ##  telefon och adressregister              ##
330 ! ##                                          ##
340 ! ##############################################
350 ! 
360 ! -----------------------------------------------
370 ! Jag {r MYCKET intresserad av synpunkter och
380 ! f|rslag till f|rb{ttringar. Det g}r att n}
390 ! mig med kommandot 'BREV' i MSG t.e.x.
400 ! -----------------------------------------------
410 ! 
420?ISAM OPEN 'REGISTER.ISM' AS FILE 2 : OPEN 'PR:VSA30A50' AS FILE 1
430 EXTEND 
440 DIM Post$=110,Nypost$=110,E$=18,F$=15,A$=24,Po$=20,Pe$=11,S1$=1,S2$=1,H$=10,T$=10
450 Text$=Text$+SPACE$(80-LEN(Text$))
460 GOTO 550
470 DEF FNInirow25(Text$) LOCAL Vdu$=0
480   OUT 56,6,57,25
490   POKE VAROOT(Vdu$),80,0,32640,127
500   Vdu$=Text$
510   RETURN -1
520 FNEND 
530 Z=FNInirow25(Text$)
540 ! 
550 GOTO 620
560 IF ERRCODE<>53 THEN PRINT : RESUME 
570 Buffer=SYS(6)
580 GET Tangent$
590 Pftangent=ASCII(Tangent$)-191
600 ON Pftangent GOTO 770,800,830,860
610 END 
620 ; CHR$(12)
630 Text$='          Detta {r menyn till REGISTER.BAC av (c) Jinge Fl~cht <4716>         ' : Z=FNInirow25(Text$)
640 ; " REGISTER.BAC                                                   Version 2.3 "
650 ; STRING$(80,61)
660 ; " Meny                                                          REGISTER.BAC "
670 ; CUR(9,20) 'Pf - 1  Inmatning'
680 ; CUR(11,20) 'Pf - 2  S|kning'
690 ; CUR(13,20) 'Pf - 3  Listning p} printer'
700 ; CUR(15,20) 'Pf - 4  Avsluta'
710 ; CUR(21,0) STRING$(80,95)
720 ON ERROR GOTO 560
730 INPUT W$
740 GOTO 620
750 Z=FNEtt
760 GOTO 540
770 RESUME 750
780 Z=FNTv}
790 GOTO 540
800 RESUME 780
810 Z=FNTre
820 GOTO 540
830 RESUME 810
840 Z=FN]tta
850 GOTO 540
860 RESUME 840
870 DEF FNEtt
880   Z=FNRen : Text$='                 Nu {r Du i inmatningsdelen av programmet.                    ' : Z=FNInirow25(Text$)
890   ; CUR(3,0) " Pf 1 "
900   ; CUR(21,0)
910   ; CUR(22,0) '                                                           '
920   Z=FNSk{rm
930   Z=FNInmatning
940   Z=FNKoda
950???ISAM WRITE #2,Post$
960   Text$=' Om Du har fler poster Du vill mata in p} en g}ng skall Du trycka p} siffra 0 ' : Z=FNInirow25(Text$)
970   ; CUR(22,0) ''; : GET W$
980   IF W$='0' THEN 910
990   RETURN -1
1000 FNEND 
1010 DEF FNTv}
1020   ; CUR(3,0) " Pf 2 "
1030   Z=FNRen : Text$=' Nu {r det meningen att Du skall v{lja det index som maskinen skall g} efter. ' : Z=FNInirow25(Text$)
1040   Z=FNIndex : Z=FNS|k
1050   ; CUR(21,0)
1060   RETURN -1
1070 FNEND 
1080 DEF FNTre
1090   ; CUR(3,0) " Pf 3 "
1100   Text$=' Nu {r det meningen att Du skall v{lja det index som maskinen skall g} efter. ' : Z=FNInirow25(Text$)
1110   Z=FNIndex
1120   Z=FNUtskrift
1130   ; CUR(21,0)
1140   GET W$
1150   RETURN -1
1160 FNEND 
1170 DEF FN]tta
1180   ; CUR(3,0) " Pf 8 "
1190   Text$='                                 Avslut                                       ' : Z=FNInirow25(Text$)
1200   ; CUR(10,10) '[r Du s{ker (J/N)'; : GET W$
1210   IF W$='j' OR W$='J' THEN 1230
1220   GOTO 1260
1230   ; CHR$(12) : CLOSE : CHAIN 'NUL:'
1240   ; CUR(21,0)
1250   GET W$
1260   RETURN -1
1270 FNEND 
1280 DEF FNRen
1290   FOR I=4 TO 19
1300     ; CUR(I,0) '                                                                              '
1310   NEXT I 
1320   RETURN 0
1330 FNEND 
1340 DEF FNKoda
1350   E$=E$+SPACE$(18-LEN(E$))
1360   F$=F$+SPACE$(15-LEN(F$))
1370   A$=A$+SPACE$(24-LEN(A$))
1380   Po$=Po$+SPACE$(20-LEN(Po$))
1390   Pe$=Pe$+SPACE$(11-LEN(Pe$))
1400   S1$=S1$+SPACE$(1-LEN(S1$))
1410   S2$=S2$+SPACE$(1-LEN(S2$))
1420   H$=H$+SPACE$(10-LEN(H$))
1430   T$=T$+SPACE$(10-LEN(T$))
1440   IF W$='0' THEN 1470
1450   Post$=E$+F$+A$+Po$+Pe$+S1$+S2$+H$+T$
1460   GOTO 1480
1470   Nypost$=E$+F$+A$+Po$+Pe$+S1$+S2$+H$+T$
1480   RETURN 0
1490 FNEND 
1500 DEF FNAvkoda
1510   E$=MID$(Post$,1,18)
1520   F$=MID$(Post$,19,15)
1530   A$=MID$(Post$,34,24)
1540   Po$=MID$(Post$,58,20)
1550   Pe$=MID$(Post$,78,11)
1560   S1$=MID$(Post$,89,1)
1570   S2$=MID$(Post$,90,1)
1580   H$=MID$(Post$,91,10)
1590   T$=MID$(Post$,101,10)
1600   RETURN 0
1610 FNEND 
1620 DEF FNInmatning
1630   ON ERROR GOTO 1790
1640   Z=FNSk{rm
1650   Text$='                 Nu {r Du i inmatningsdelen av programmet.                    ' : Z=FNInirow25(Text$)
1660   ; CUR(7,26); : INPUT E$
1670   ; CUR(8,26); : INPUT F$
1680   ; CUR(9,26); : INPUT A$
1690   ; CUR(10,26); : INPUT Po$
1700   ; CUR(11,26); : INPUT Pe$
1710   ; CUR(12,26); : INPUT S1$
1720   ; CUR(13,26); : INPUT S2$
1730   ; CUR(14,26); : INPUT H$
1740   ; CUR(15,26); : INPUT T$
1750   Text$='                          [r detta riktigt?  jJ / (nN)                        ' : Z=FNInirow25(Text$)
1760   ; CUR(22,0) ''; : GET W$
1770   IF W$='j' OR W$='J' THEN 1810
1780   GOTO 1630
1790   ; CHR$(7); : ; CUR(17,10) 'Se hur m}nga tecken Du f}r anv{nda!!'
1800   RESUME 1630
1810   RETURN 0
1820 FNEND 
1830 DEF FNSk{rm
1840   ; CUR(7,10) 'Efternamn       :                   <---------------'
1850   ; CUR(8,10) 'F|rnamn         :                <------------------'
1860   ; CUR(9,10) 'Adress          :                         <---------'
1870   ; CUR(10,10) 'Postadress      :                     <-------------'
1880   ; CUR(11,10) 'Personnummer    :            <----------------------'
1890   ; CUR(12,10) 'Sorteringsordn  :  <--------------------------------'
1900   ; CUR(13,10) 'S|kbegrepp id   :  <--------------------------------'
1910   ; CUR(14,10) 'Referens        :           <-----------------------'
1920   ; CUR(15,10) 'Telefonnummer   :           <-----------------------'
1930   RETURN 0
1940 FNEND 
1950 DEF FNIndex
1960   ; CUR(8,10) '  1 - Efternamn'
1970   ; '            2 - F|rnamn'
1980   ; '            X - Adress'
1990   ; '            X - Postadress (postnummer+ort)'
2000   ; '            5 - Personnummer'
2010   ; '            6 - S|kbegrepp 1'
2020   ; '            X - S|kbegrepp 2'
2030   ; '            X - Referens'
2040   ; '            X - Telefonnummer'
2050   ; 
2060   ; 'Du v{ljer 1-9 '; : GET W$
2070   IF W$='1' THEN I$='E'
2080   IF W$='2' THEN I$='F'
2090   IF W$='3' THEN I$='A'
2100   IF W$='4' THEN I$='PO'
2110   IF W$='5' THEN I$='PE'
2120   IF W$='6' THEN I$='S1'
2130   IF W$='7' THEN I$='S2'
2140   IF W$='8' THEN I$='H'
2150   IF W$='9' THEN I$='T'
2160   RETURN 0
2170 FNEND 
2180 DEF FNS|k
2190   Z=FNRen
2200   Z=FNSk{rm
2210   Text$=' Nu skall Du skriva  nyckeln Du s|ker. Det r{cker ofta med ett par tre tecken ' : Z=FNInirow25(Text$)
2220   ; CUR(20,0) 'S|knyckel '; : INPUT S$
2230   ; CUR(20,0) '                           '
2240   ON ERROR GOTO 2370
2250   Text$=' 0=Lista vidare      1=Ta bort      2=Uppdatera      3=Skriv p} printer ' : Z=FNInirow25(Text$)
2260???ISAM READ #2,Post$ INDEX I$ KEY S$
2270   GOTO 2300
2280   ON ERROR GOTO 2370
2290???ISAM READ #2,Post$ INDEX I$ NEXT 
2300   Z=FNAvkoda
2310   Z=FNNy
2320   ; CUR(22,0) ''; : GET W$
2330   IF W$='0' THEN 2280
2340   IF W$='1' THEN Z=FNBort
2350   IF W$='2' THEN Z=FNUpp
2360   RETURN 0
2370   ; CHR$(7)
2380   Text$=' Nu {r det slut p} posterna # ELLER # Posten Du s|kte efter finns inte h{r... ' : Z=FNInirow25(Text$)
2390   GET W$
2400   RESUME 2360
2410 FNEND 
2420 DEF FNBort
2430   Text$='                      [r Du RIKTIGT s{ker ??   jJ / (nN)                      ' : Z=FNInirow25(Text$)
2440   ; CUR(22,0); : GET W$
2450   IF W$='j' OR W$='J' THEN 2470
2460   GOTO 2490
2470   Text$='                        Nu g}r suddgummit inne i driven                       ' : Z=FNInirow25(Text$)
2480???ISAM DELETE #2,Post$
2490   RETURN 0
2500 FNEND 
2510 DEF FNUpp
2520   Text$='                  Nu skall Du v{lja VAD Du vill {ndra p}   1 - 9              ' : Z=FNInirow25(Text$)
2530   ; CUR(7,7) '1'
2540   ; CUR(8,7) '2'
2550   ; CUR(9,7) '3'
2560   ; CUR(10,7) '4'
2570   ; CUR(11,7) '5'
2580   ; CUR(12,7) '6'
2590   ; CUR(13,7) '7'
2600   ; CUR(14,7) '8'
2610   ; CUR(15,7) '9'
2620   ; CUR(22,0) 'Du v{ljer: '; : GET W$
2630   Text$=' N{r Du {ndrat klart med 1,2,3,4,5,6,7,8 eller 9, s} uppdaterar Du med   -0-  ' : Z=FNInirow25(Text$)
2640   ; CUR(16,0) ''
2650   IF W$='1' THEN INPUT E$
2660   IF W$='2' THEN INPUT F$
2670   IF W$='3' THEN INPUT A$
2680   IF W$='4' THEN INPUT Po$
2690   IF W$='5' THEN INPUT Pe$
2700   IF W$='6' THEN INPUT S1$
2710   IF W$='7' THEN INPUT S2$
2720   IF W$='8' THEN INPUT H$
2730   IF W$='9' THEN INPUT T$
2740   IF W$='0' THEN Z=FNUppdatera
2750   IF W$='0' THEN 2790
2760   Z=FNSk{rm
2770   Z=FNNy
2780   GOTO 2530
2790   RETURN 0
2800 FNEND 
2810 DEF FNUppdatera
2820   Z=FNKoda
2830   Text$='                Nu uppdaterar jag s} att svetten lackar....                   ' : Z=FNInirow25(Text$)
2840???ISAM UPDATE #2,Post$ TO Nypost$
2850   RETURN 0
2860 FNEND 
2870 DEF FNNy
2880   ; CUR(7,28) E$
2890   ; CUR(8,28) F$
2900   ; CUR(9,28) A$
2910   ; CUR(10,28) Po$
2920   ; CUR(11,28) Pe$
2930   ; CUR(12,28) S1$
2940   ; CUR(13,28) S2$
2950   ; CUR(14,28) H$
2960   ; CUR(15,28) T$
2970   RETURN 0
2980 FNEND 
2990 DEF FNUtskrift
3000   ON ERROR GOTO 3110
3010   Text$='                               Utskrift p}g}r                                 ' : Z=FNInirow25(Text$)
3020   ; #1 'Efternamn          F|rnamn         Adress                   Postadress           Telefonnummer'
3030   ; #1 '----------------------------------------------------------------------------------------------'
3040   ; #1
3050???ISAM READ #2,Post$ INDEX I$ FIRST 
3060   Z=FNAvkoda
3070   ; #1,E$ ' ' F$ ' ' A$ ' ' Po$ ' ' T$
3080???ISAM READ #2,Post$ INDEX I$ NEXT 
3090   B=B+1 : IF B=38 THEN B=FNB
3100   GOTO 3060
3110   RETURN 0
3120 FNEND 
3130 DEF FNB
3140   B=0
3150   Z=FNRen
3160   ; CUR(10,10) 'Justera skrivaren och tryck p} return! '; : GET Q$
3170   RETURN 0
3180 FNEND