| 10 |
AUTOGOTO 70 |
| 70 |
"A" GOSUB 7490 :CHAIN "X:ADBCHN.PRG",70 |
| 170 |
RESTORE 190 :GOTO 7290 |
| 190 |
DATA 1,"SUCHE",2,"Nachname",210,"Vorname",220,"Geburtstag",360 |
| 210 |
PRINT "Nachname:":L=0:GOTO 230 |
| 220 |
PRINT "Vorname:":L=1 |
| 230 |
M$(0)="A":INPUT M$(0) |
| 240 |
IF LEN M$(0)<3 LET M$(0)=M$(0)+"aa" |
| 250 |
GOSUB 6490 :IF F5 GOTO 230 |
| 260 |
POKE 12348,16:CLEAR A:B=G |
| 270 |
P=S(0,L):IF M$(0)<D$(P,L) LET R=0:RETURN |
| 280 |
R=INT ((A+B)/2) |
| 290 |
P=S(R,L) |
| 300 |
IF D$(P,L)=M$(0) GOTO 340 |
| 310 |
IF B-A=1 LET R=R+1:P=S(R,L):RETURN |
| 320 |
IF D$(P,L)<M$(0) LET A=R:GOTO 280 |
| 330 |
B=R:GOTO 280 |
| 340 |
IF R IF D$(S(R-1,L),L)=M$(0) LET R=R-1:P=S(R,L):GOTO 340 |
| 350 |
RETURN |
| 360 |
PRINT "Geburtstag:":INPUT M$(0) |
| 370 |
L=2:CLEAR A:B=G:IF M$(0)="" CLEAR U,V:GOTO 400 |
| 380 |
U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=1900:GOSUB 490 |
| 390 |
IF F5 GOSUB 6510 :GOTO 360 |
| 400 |
W=U+V*31 |
| 410 |
P=S(0,2):IF W<VAL LEFT$ (D$(P,5),2)+31*VAL MID$ (D$(P,5),4,2) LET R=0:RETURN |
| 420 |
R=INT ((A+B)/2):P=S(R,2):H=VAL LEFT$ (D$(P,5),2)+31*VAL MID$ (D$(P,5),4,2) |
| 430 |
IF H=W GOTO 470 |
| 440 |
IF B-A=1 LET R=R+1:P=S(R,L):RETURN |
| 450 |
IF H<W LET A=R:GOTO 420 |
| 460 |
B=R:GOTO 420 |
| 470 |
IF R LET H=S(R-1,2):IF VAL LEFT$ (D$(H,5),2)+31*VAL MID$ (D$(H,5),4,2)=W LET P=H:R=R-1:GOTO 470 |
| 480 |
RETURN |
| 490 |
CLEAR F5:IF U<1 OR U>31 OR V<1 OR V>12 OR W<1890 OR W>1999 LET F5=1:GOTO 520 |
| 500 |
IF (V=4 OR V=6 OR V=9 OR V=11) AND U>30 LET F5=1:GOTO 520 |
| 510 |
IF V=2 AND U>29 LET F5=1 |
| 520 |
RETURN |
| 530 |
RESTORE 550 :GOTO 7290 |
| 550 |
DATA 1,LEFT$ (D$(P,1)+" "+D$(P,0),24),2,"o.k.",610 |
| 560 |
DATA "weiter",570,"zurueck",590 |
| 570 |
R=R+1:IF R>G BEEP 1,255,100:R=G |
| 580 |
P=S(R,L):GOTO 530 |
| 590 |
R=R-1:IF -R CLEAR R:BEEP 1,255,100 |
| 600 |
P=S(R,L):GOTO 530 |
| 610 |
RETURN |
| 690 |
F4=LEN (D$(P,0)+D$(P,1))<24 |
| 700 |
IF F4 PRINT D$(P,1);" ";D$(P,0):GOTO 720 |
| 710 |
PRINT D$(P,1):PRINT D$(P,0) |
| 720 |
PRINT D$(P,2):IF F4=0WAIT |
| 730 |
PRINT D$(P,3):IF F4=0WAIT 0:GOTO 750 |
| 740 |
IF F4 GOSUB 6300 |
| 750 |
WAIT 0:CLS :FOR W=4 TO 6:PRINT D$(P,W):NEXT W:GOSUB 6300 |
| 760 |
RETURN |
| 2410 |
IF F1=0 BEEP 1,255,100:PRINT "Keine Datei !":GOSUB 6300 :GOTO 40 |
| 2420 |
RESTORE 2430 :GOTO 7290 |
| 2430 |
DATA 1,"PFLEGE",5,"Satz dazu",2450,"Datei neu",7450,"Aenderung",2750 |
| 2440 |
DATA "Loeschen",3190,"Sortieren",3410,"MENU",70 |
| 2450 |
IF G=M PRINT "Speicher voll !":GOSUB 6300 :GOTO 70 |
| 2460 |
G=G+1:F6=F6+1:CLEAR F2 |
| 2470 |
M$(0)="":PRINT "Name:":INPUT M$(0) |
| 2480 |
GOSUB 6490 :IF F5GOTO 2470 |
| 2490 |
D$(G,0)=M$(0) |
| 2500 |
M$(0)="":PRINT "Vorname:":INPUT M$(0) |
| 2510 |
CLS :IF M$(0)=""GOTO 2530 |
| 2520 |
GOSUB 6490 :IF F5GOTO 2500 |
| 2530 |
D$(G,1)=M$(0) |
| 2540 |
M$(0)="":PRINT "Strasse:":INPUT M$(0) |
| 2550 |
GOSUB 6490 :IF F5GOTO 2540 |
| 2560 |
D$(G,2)=M$(0) |
| 2570 |
PRINT "PLZ Ort:":INPUT D$(G,3) |
| 2580 |
CLS :IF VAL D$(G,3)=0 LET M$(0)=D$(G,3):GOTO 2600 |
| 2590 |
M$(0)=RIGHT$ (D$(G,3),(LEN D$(G,3)-LEN STR$ VAL D$(G,3)-1)) |
| 2600 |
GOSUB 6490 |
| 2610 |
IF F5 GOTO 2570 |
| 2620 |
PRINT "Telefon:":INPUT D$(G,4) |
| 2630 |
CLS :M$(0)="":PRINT "Geburtsdatum:":INPUT M$(0) |
| 2640 |
IF M$(0)="" CLEAR U,V:GOTO 2710 |
| 2650 |
CLEAR F5:IF LEN M$(0)<>10 LET F5=1:GOTO 2690 |
| 2660 |
U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=VAL RIGHT$ (M$(0),4) |
| 2670 |
GOSUB 490 |
| 2680 |
IF V=2 AND (W/4<>INT (W/4) OR W/400=INT (W/400)) AND U>28 LET F5=1 |
| 2690 |
GOSUB 6510 :IF F5 GOTO 2630 |
| 2700 |
D$(G,5)=M$(0) |
| 2710 |
CLS :PRINT "Bemerkung:":INPUT D$(G,6) |
| 2720 |
POKE 12348,16:CLS :P=G |
| 2730 |
PRINT "Kontrollausgabe:":GOSUB 6300 |
| 2740 |
GOSUB 690 :RESTORE 2745 :GOTO 7290 |
| 2745 |
DATA 1,"Datensatz",1,"o.k.",2410,"aendern",2770 |
| 2750 |
PRINT "Zu aendernder Datensatz:":GOSUB 6300 |
| 2760 |
GOSUB 170 :GOSUB 530 |
| 2770 |
PRINT "alter Name:":PRINT D$(P,0):PRINT "neuer Name:" |
| 2780 |
M$(0)=D$(P,0):INPUT M$(0) |
| 2790 |
CLS :POKE 12348,16:IF M$(0)=D$(P,0)GOTO 2820 |
| 2800 |
GOSUB 6490 :IF F5 GOTO 2770 |
| 2810 |
F7=1:F2=0:D$(P,0)=M$(0) |
| 2820 |
PRINT "alter Vorname:":PRINT D$(P,1):PRINT "neuer Vorname:" |
| 2830 |
M$(0)=D$(P,1):INPUT M$(0) |
| 2840 |
CLS :POKE 12348,16:IF M$(0)=D$(P,1)GOTO 2870 |
| 2850 |
GOSUB 6490 :IF F5 GOTO 2820 |
| 2860 |
F7=1:F2=0:D$(P,1)=M$(0) |
| 2870 |
PRINT "alte Strasse:":PRINT D$(P,2):PRINT "neue Strasse:" |
| 2880 |
M$(0)=D$(P,2):INPUT M$(0) |
| 2890 |
CLS :POKE 12348,16:IF M$(0)=D$(P,2) GOTO 2920 |
| 2900 |
GOSUB 6490 :IF F5 GOTO 2870 |
| 2910 |
F2=0:D$(P,2)=M$(0) |
| 2920 |
PRINT "alter Ort:":PRINT D$(P,3):PRINT "neuer Ort:" |
| 2930 |
M$(0)=D$(P,3):INPUT M$(0) |
| 2940 |
CLS :POKE 12348,16:IF M$(0)=D$(P,3) GOTO 2980 |
| 2950 |
F2=0:D$(P,3)=M$(0) |
| 2960 |
M$(0)=RIGHT$ (M$(0),LEN M$(0)-LEN STR$ VAL M$(0)-1):GOSUB 6490 |
| 2970 |
IF F5 GOTO 2920 |
| 2980 |
PRINT "alte Telefonnr.:":PRINT D$(P,4):PRINT "neue Telefonnr.:" |
| 2990 |
M$(0)=D$(P,4):INPUT M$(0) |
| 3000 |
CLS :IF M$(0)=D$(P,4) GOTO 3020 |
| 3010 |
F2=0:D$(P,4)=M$(0) |
| 3020 |
PRINT "alter Geburtstag:":PRINT D$(P,5):PRINT "neuer Geburtstag:" |
| 3030 |
CLEAR F5:M$(0)=D$(P,5):INPUT M$(0) |
| 3040 |
CLS :IF D$(P,5)=M$(0) GOTO 3130 |
| 3050 |
IF M$(0)=" " CLEAR U,V:GOTO 3120 |
| 3060 |
U=VAL LEFT$ (M$(0),2):V=VAL MID$ (M$(0),4,2):W=VAL RIGHT$ (M$(0),4) |
| 3070 |
IF U<1 OR U>31 OR V<1 OR V>12 OR W<1890 OR W>1999 LET F5=1:GOTO 3110 |
| 3080 |
IF (V=4 OR V=6 OR V=9 OR V=11) AND U>30 LET F5=1:GOTO 3110 |
| 3090 |
IF V=2 AND U>29 LET F5=1:GOTO 3110 |
| 3100 |
IF V=2 AND (W/4<>INT (W/4) OR W/400=INT (W/400)) AND U>28 LET F5=1 |
| 3110 |
GOSUB 6510 :IF F5 GOTO 3020 |
| 3120 |
F7=1:F2=0:D$(P,5)=M$(0) |
| 3130 |
PRINT "alte Bemerkung:":PRINT D$(P,6):PRINT "neue Bemerkung:" |
| 3140 |
M$(0)=D$(P,6):INPUT M$(0) |
| 3150 |
CLS :POKE 12348,16:IF D$(P,6)=M$(0) GOTO 2730 |
| 3160 |
F2=0:D$(P,6)=M$(0) |
| 3180 |
GOTO 2730 |
| 3190 |
PRINT "Zu loeschender Datensatz:":GOSUB 6300 |
| 3200 |
GOSUB 170 :GOSUB 530 :GOSUB 690 |
| 3210 |
RESTORE 3230 :GOTO 7290 |
| 3230 |
DATA 1,">>> ACHTUNG <<<",1,"PFLEGEMENU",2410,"Datensatz loeschen |
| 3240 |
DATA 3250 |
| 3250 |
CLEAR F2:IF P=GGOTO 3270 |
| 3260 |
FOR I=0 TO 6:D$(P,I)=D$(G,I):NEXT I |
| 3270 |
FOR L=0 TO 2:U=-1:V=-1:FOR I=0 TO G |
| 3280 |
IF S(I,L)=P LET U=I |
| 3290 |
IF S(I,L)=G LET V=I |
| 3300 |
IF U>-1 AND V>-1 LET I=G |
| 3310 |
NEXT I |
| 3320 |
S(V,L)=P |
| 3330 |
IF U=G GOTO 3370 |
| 3340 |
FOR I=U+1 TO G |
| 3350 |
S(I-1,L)=S(I,L) |
| 3360 |
NEXT I |
| 3370 |
NEXT L |
| 3380 |
FOR I=0 TO 6:D$(G,I)="":NEXT I:FOR I=0 TO 2:S(G,I)=0:NEXT I |
| 3390 |
G=G-1:PRINT "Datensatz geloescht !":GOSUB 6300 |
| 3400 |
GOTO 70 |
| 6300 |
WAIT :CURSOR 17,3:PRINT CHR$ 91;"ENTER";CHR$ 93:WAIT 0:BEEP 1,1,25:CLS :RETURN |
| 6490 |
CLEAR F5:H=ASC LEFT$ (M$(0),1):IF H<65 OR H>90 AND H<>32 AND H<>0 LET F5=1 |
| 6500 |
H=ASC MID$ (M$(0),2,1):IF H<97 OR H>122 AND H<>46 AND H<>32 AND H<>0 LET F5=1 |
| 6510 |
CLS :IF F5 BEEP 1,255,200:RESTORE 6550 :GOTO 7290 |
| 6520 |
POKE 12348,16 |
| 6530 |
RETURN |
| 7290 |
CLS :WAIT 0:READ F0:IF F0 READ M$(0):PRINT M$(0) |
| 7300 |
X=0:Y=F0:READ N:Q=INT (N/(4-F0)):S=16-4*Q |
| 7310 |
FOR I=0 TO N:J=INT (I/(4-F0)):CURSOR J*S,I-(4-F0)*J+F0:READ M$(0),Z(I) |
| 7320 |
PRINT " ";LEFT$ (M$(0),S+6-8*SGN Q):NEXT I |
| 7330 |
K=Y-F0+(4-F0)*X:IF K>N LET X=Q:Y=F0+N-(4-F0)*X:K=N |
| 7340 |
CURSOR X*S,Y:PRINT "->" |
| 7350 |
T=ASC INKEY$ :IF T=0 GOTO 7350 |
| 7360 |
BEEP 1,1,25 |
| 7370 |
IF T=5 CURSOR X*S,Y:PRINT " ":Y=Y+1:IF Y>3 LET Y=F0:X=X+1:IF X>Q CLEAR X |
| 7380 |
IF T=4 CURSOR X*S,Y:PRINT " ":Y=Y-1:IF Y<F0 LET Y=3:X=X-1:IF -X CLEAR X |
| 7390 |
IF T=14 CURSOR X*S,Y:PRINT " ":X=X+1:IF X>Q CLEAR X |
| 7400 |
IF T=15 CURSOR X*S,Y:PRINT " ":X=X-1:IF X<0 LET X=Q |
| 7410 |
IF T=13 CLS :CLEAR X,Y:GOTO Z(K) |
| 7420 |
GOTO 7330 |
| 7490 |
RESTORE 7500 :GOTO 7290 |
| 7500 |
DATA 1,"Externer Programmteil !",1,"CE-140F o.k.",7510,"Abbruch",7520 |
| 7510 |
RETURN |
| 7520 |
CLS :END |
