Adressdatenbank und Organizer (mod) - Listing

Dokumentation ansehen
Programmspeicher-Image laden

10	REM AUTOGOTO 20
20	"A"CLS :WAIT 0
30	IF C2=0 GOSUB 7430
40	IF FP GOTO 6000
50	IF F6 OR F7 OR G7 OR H7 GOTO 3410
60	IF F1=0 OR F2=0 GOTO 3950
70	RESTORE 100
80	GOTO 7290
100	DATA 1,"MENU",5,"Suchen",620,"Liste",1860,"Pflege",2410
110	DATA "Optionen",4890,"Transfer",3950,"ENDE",120
120	PRINT "Adressdatenbank beendet,":PRINT "Neustart mit ";CHR$ 91;"DEF";CHR$ 93;" ";CHR$ 91;
130	PRINT "A";CHR$ 93;" !"
140	GOSUB 6300 :WAIT :CLS
150	END
160	PRINT "Datenbankzugang verwehrt":END
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)<4 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.",690
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
620	IF F1=0 BEEP 1,255,100:PRINT "Keine Datei !":GOSUB 6300 :GOTO 40
625	GOSUB 170
680	GOSUB 690 :GOTO 70
685	"B"GOSUB 530 :GOTO 70
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=0 WAIT
730	PRINT D$(P,3):IF F4=0 WAIT 0:GOTO 750
740	IF F4 GOSUB 6300
750	WAIT 0:CLS :FOR W=4 TO 6:PRINT D$(P,W):NEXT W
755	GOSUB 6300
760	RETURN
770	"D"GOSUB 6310 :ON C1 GOTO 780 ,820 ,680
780	RESTORE 800 :GOTO 7290
800	DATA 1,"DRUCK AUF CE-140P",3,"Datensatz",820,"Briefkopf",870,"Grafik"
810	DATA 1200,"MENU",70
820	PRINT "Datensatz wird gedruckt
830	GOSUB 840 :GOTO 70
840	IF LEN (D$(P,0)+D$(P,1))<24+(C1=1)*15 LPRINT D$(P,1)+" "+D$(P,0):GOTO 860
850	LPRINT D$(P,1):LPRINT D$(P,0)
860	FOR I=2 TO 6:LPRINT D$(P,I):NEXT I:LPRINT :RETURN
870	GRAPH
880	LLINE (60,0)-(480,0)-(480,-200)-(60,-200)-(60,0)
890	LLINE (0,-285)-(20,-285):LLINE (85,-40)-(460,-40),1
900	GLCURSOR (85,-90):CONSOLE 31:RESTORE 920 :GOTO 7290
920	DATA 1,"erste Zeile:",5,"An",940,"Herr",940,"Frau",940,"Fraeulein"
930	DATA 940,"Firma",940,"<eingeben>",1000
940	ON K+1 GOTO 950 ,960 ,970 ,980 ,990
950	LPRINT "PAn":GOTO 1010
960	LPRINT "PHerr":GOTO 1010
970	LPRINT "PFrau":GOTO 1010
980	LPRINT "PFraeulein":GOTO 1010
990	LPRINT "PFirma":GOTO 1010
1000	GOSUB 6420 :LPRINT "P";LEFT$ (T$(0),31)
1010	GLCURSOR (85,-114)
1020	IF LEN (D$(P,0)+D$(P,1))>30 LPRINT "P";LEFT$ (D$(P,1),1);". ":GOTO 1040
1030	LPRINT "P";D$(P,1);" "
1040	LPRINT "P";D$(P,0)
1050	GLCURSOR (85,-138):LPRINT "P";D$(P,2)
1060	GLCURSOR (85,-162):LPRINT "P";D$(P,3)
1070	GLCURSOR (85,-28):CSIZE 1:CONSOLE 62
1080	RESTORE 1100 :GOTO 7290
1100	DATA 1,"Absender:",2,"M. Janssen",1130,"<suchen>",1140,"<eingeben>"
1110	DATA 1120
1120	GOSUB 6420 :LPRINT "P";T$(0):GOTO 1180
1130	LPRINT "P<Tragen Sie hier Ihre Adresse ein!>":GOTO 1180
1140	GOSUB 170 :GOSUB 530
1150	IF LEN (D$(P,0)+D$(P,1)+D$(P,2)+D$(P,3))>54 GOTO 1170
1160	LPRINT "P";D$(P,1);" "
1170	LPRINT "P";D$(P,0);" / ";D$(P,2);" / ";D$(P,3)
1180	GLCURSOR (0,-360):LPRINT CHR$ 27+"@"
1190	GOTO 70
1200	GRAPH :CROTATE 1:GLCURSOR (480,0):SORGN :CLEAR GX,GY,G1,G2,G3,Z,G4
1210	RESTORE 1230 :GOTO 7290
1230	DATA 1,"GRAFIK",8,"Zeile",1290,"Druck",1440,"Farbe",1260,"Typ"
1240	DATA 1370,"Unter.",1810,"Zeigen",1270,"Suchen",1740,"RAHMEN",1750,"MENU
1250	DATA 1660
1260	GOSUB 1680 :GOTO 1210
1270	GLCURSOR (-GY,-Z-100):GOSUB 6300 :GLCURSOR (-GY,-GX)
1280	GOTO 1210
1290	GX=0:RESTORE 1310 :GOTO 7290
1310	DATA 1,"ZEILE",8,"2.4mm",1340,"4.8mm",1340,"7.2mm",1340
1320	DATA " 9.6mm",1340,"12.0mm",1340,"14.4mm",1340,"16.8mm",1340,"19.2mm"
1330	DATA 1340,"GRAFIK",1210
1340	CSIZE K+1:GY=GY+12*K+20
1350	GLCURSOR (-GY,0):G2=K+1
1360	GOTO 1210
1370	RESTORE 1390 :GOTO 7290
1390	DATA 1,"SCHRIFT",2,"normal",1410,"g e s p e r r t",1420,"sscchhaatteenn
1400	DATA 1430
1410	G1=0:GOTO 1210
1420	G1=1:GOTO 1210
1430	G1=2:GOTO 1210
1440	IF GY=0 BEEP 1,255,100:GOTO 1290
1450	RESTORE 1470 :GOTO 7290
1470	DATA 0,7,"Name",1490,"Vorname",1490,"Strasse",1490,"Ort",1490,"Telefon
1480	DATA 1490,"Geb.dat.",1490,"Bemerkung",1490,"<Text>",1500
1490	T$(0)=D$(P,K)+" ":GOTO 1510
1500	GOSUB 6420
1510	A=GX,B=GY+2*G2
1520	FOR I=1 TO LEN T$(0)
1530	IF G3COLOR RND 7-1,7
1540	LPRINT "P"+MID$ (T$(0),I,1)
1550	IF G3COLOR RND 7-1,7
1560	IF G1=2 GLCURSOR (-GY+G2,-GX-G2):LPRINT "P"+MID$ (T$(0),I,1)
1570	GX=GX+G2*6:IF G1=1 LET GX=GX+G2*6
1580	GLCURSOR (-GY,-GX)
1590	NEXT I
1600	IF GX>Z LET Z=GX
1610	IF G3COLOR RND 7-1,7
1620	ON G4+1 GOTO 1640 ,1630 ,1630 ,1650
1630	LLINE (-B,-GX)-(-B,-A),NOT (G4-1)+2
1640	GLCURSOR (-GY,-GX):GOTO 1210
1650	LLINE (-B,-GX)-(-B,-A),0:LLINE (-B-5,-A)-(-B-5,-GX):GLCURSOR (-GY,-GX):GOTO 1210
1660	GLCURSOR (-480,-Z-100):LPRINT CHR$ 27+"@"
1670	GOTO 70
1680	RESTORE 1700 :GOTO 7290
1700	DATA 0,7,"Schwarz",1720,"Violett",1720,"Rot",1720,"Rosa",1720,"Gruen"
1710	DATA 1720,"Blau",1720,"Gelb",1720,"bunt/ohne",1730
1720	G3=0:COLOR K,7:RETURN
1730	G3=1:RETURN
1740	GOSUB 170 :GOSUB 530 :GOTO 1210
1750	GOSUB 1680 :LLINE (-GY-20,-Z)-(0,18),0,K,B:POKE &FB20,0
1760	RESTORE 1780 :GOTO 7290
1780	DATA 1,"Hintergrund ausfuellen ?",1,"nein",1660,"ja",1790
1790	GOSUB 1680
1800	PAINT 9:GOTO 1660
1810	RESTORE 1830 :GOTO 7290
1830	DATA 1,"UNTERSTREICHEN",3,"nein",1850,"punktiert",1850,"einfach",1850
1840	DATA "doppelt",1850
1850	G4=K:GOTO 1210
1860	IF F1=0 BEEP 1,255,100:PRINT "Keine Datei !":GOSUB 6300 :GOTO 40
1870	RESTORE 1880 :GOTO 7290
1880	DATA 1,"LISTE",3,"Namen",1900,"Vornamen",1900,"Geb.tage
1890	DATA 2010,"MENU",70
1900	L=K:M$(0)="Aaa":INPUT "von: ";M$(0)
1910	IF LEN M$(0)<3 LET M$(0)=M$(0)+"aa"
1920	CURSOR 5,0:PRINT M$(0)
1930	GOSUB 260 :C=R
1940	IF D$(P,L)<M$(0) GOSUB 6290 :GOTO 40
1950	M$(0)="Zzz":INPUT "bis: ";M$(0)
1960	CURSOR 5,1:PRINT M$(0)
1970	IF D$(P,L)>M$(0) GOSUB 6290 :GOTO 40
1980	GOSUB 260
1990	IF D$(P,L)>M$(0) LET R=R-1:P=S(R,L)
2000	GOTO 2100
2010	L=2:M$(0)="01.01.":INPUT "von: ";M$(0)
2020	CURSOR 5,0:PRINT M$(0)
2030	GOSUB 370 :C=R
2040	IF U+V*31<VAL LEFT$ (M$(0),2)+VAL MID$ (M$(0),4,2)*31 GOSUB 6290 :GOTO 40
2050	M$(0)="31.12.":INPUT "bis: ";M$(0)
2060	CURSOR 5,1:PRINT M$(0)
2070	IF U+V*31>VAL LEFT$ (M$(0),2)+VAL MID$ (M$(0),4,2)*31 GOSUB 6290 :GOTO 40
2080	GOSUB 370
2090	IF U+V*31<VAL LEFT$ (D$(P,5),2)+VAL MID$ (D$(P,5),4,2)*31 LET R=R-1:P=S(R,L)
2100	GOSUB 6310
2110	RESTORE 2130 :GOTO 7290
2130	DATA 1,"FORMAT",2,"komplette Datensaetze",2150
2140	DATA "Geb.dat./Name/Vorname",2160,"lfd.Nr./Name/Vorname",2240
2150	FOR J=C TO R:P=S(J,L):ON C1 GOSUB 840 ,840 ,690 :NEXT J:GOTO 70
2160	IF C1<>3 PRINT =LPRINT :PRINT " "
2170	FOR J=C TO R:P=S(J,L):PRINT D$(P,5)
2180	IF LEN (D$(P,1)+D$(P,0))<24 PRINT D$(P,1)+" "+D$(P,0):GOTO 2200
2190	PRINT D$(P,1):PRINT D$(P,0)
2200	IF C1=3 GOSUB 6300 :GOTO 2220
2210	PRINT " "
2220	NEXT J
2230	PRINT =PRINT :GOTO 70
2240	IF C1<>3 PRINT =LPRINT :PRINT " "
2250	W=SGN L
2260	CLEAR U,V:FOR J=C TO R:P=S(J,L):USING "####"
2270	T=J-C+1
2280	IF LEN D$(P,W)<19+15*(C1=1) GOTO 2310
2290	IF V<>INT V AND C1=3 GOSUB 6300 :U=U-INT ((V-INT V+2E-10)*3)
2300	PRINT T;") ":USING :PRINT D$(P,W):PRINT D$(P,NOT W+2):U=U+2:GOTO 2370
2310	IF LEN (D$(P,0)+D$(P,1))<18+15*(C1=1) GOTO 2350
2320	IF V<>INT V AND C1=3 GOSUB 6300 :U=U-INT ((V-INT V+2E-10)*3)
2330	PRINT T;") ";
2340	USING :PRINT D$(P,W):PRINT " ";D$(P,NOT W+2):U=U+1:GOTO 2370
2350	PRINT T;") ";
2360	USING :PRINT D$(P,W);" ";D$(P,NOT W+2)
2370	V=(T+U)/3
2380	IF V=INT V OR J=R AND C1=3 GOSUB 6300
2390	NEXT J
2400	PRINT =PRINT :GOTO 70
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 F5 GOTO 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 F5 GOTO 2500
2530	D$(G,1)=M$(0)
2540	M$(0)="":PRINT "Strasse:":INPUT M$(0)
2550	GOSUB 6490 :IF F5 GOTO 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	F2=0:F7=1: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	F2=0:G7=1: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	F2=0:H7=1: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=G GOTO 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
3410	IF F7 OR G7 OR H7 OR F6>=G GOTO 3690
3420	IF F6 GOTO 3470
3430	RESTORE 3450 :GOTO 7290
3450	DATA 1,"Keine neuen Daten !"
3460	DATA 2,"Sortieren",3465,"DATENPFLEGE",2410,"MENU",70
3465	F7=1:G7=1:H7=1:GOTO 3695
3470	USING "####":PRINT 0;" % einsortiert":D=3*F6:Z=0
3480	FOR I=F6 TO 1 STEP -1
3490	FOR L=0 TO 2
3500	M$(0)=D$(G-I+1,L):IF L=2 LET M$(0)=LEFT$ (D$(G-I+1,5),5):GOSUB 370 :GOTO 3520
3510	GOSUB 260
3520	ON L GOTO 3530 ,3550
3530	IF D$(P,L)=M$(0) GOTO 3630
3540	GOTO 3560
3550	IF LEFT$ (D$(P,5),5)=M$(0) GOTO 3650
3560	FOR J=G-I TO R STEP -1:S(J+1,L)=S(J,L):NEXT J
3570	S(R,L)=G-I+1
3580	Z=Z+1:CURSOR 0,0:PRINT Z/D*100
3590	NEXT L:NEXT I
3600	CLEAR F6:USING
3610	IF F8 GOTO 4180
3620	GOTO 40
3630	IF D$(P,NOT L+2)<D$(G-I+1,NOT L+2) LET R=R+1:P=S(R,L):IF R<G GOTO 3530
3640	GOTO 3560
3650	IF D$(P,0)<D$(G-I+1,0) LET R=R+1:P=S(R,L):IF R<G GOTO 3550
3660	GOTO 3560
3670	E=0:G=-1:F9=1:GOSUB 4480 :CLEAR F6,F9
3680	CLS :PRINT "Bitte Daten eingeben !":GOSUB 6300 :GOTO 2460
3690	IF F6 LET F7=1:G7=1:H7=1
3695	D=(F7+G7+H7)*(G+1)^2:Z=0:USING "####.#":PRINT 0;" % sortiert
3700	L=0:IF F7=0 GOTO 3742
3710	FOR I=0 TO G:K=0:FOR J=0 TO G
3720	IF D$(J,L)<=D$(I,L) LET K=K+1:IF D$(I,L)=D$(J,L) GOSUB 3830
3730	Z=Z+1:CURSOR 0,0:PRINT Z/D*100
3740	NEXT J:S(K,L)=I:NEXT I
3742	IF G7 LET L=1:G7=0:GOTO 3710
3746	L=2:IF H7=0 GOTO 3810
3750	FOR I=0 TO G:K=0:FOR J=0 TO G
3760	U=VAL MID$ (D$(I,5),4,2)*31+VAL LEFT$ (D$(I,5),2)
3770	V=VAL MID$ (D$(J,5),4,2)*31+VAL LEFT$ (D$(J,5),2)
3780	IF V<=U LET K=K+1:IF U=V GOSUB 3830
3790	Z=Z+1:CURSOR 0,0:PRINT Z/D*100
3800	NEXT J:S(K,2)=I:NEXT I
3810	USING :CLEAR F7,G7,H7,F6:IF F8 GOTO 4180
3820	GOTO 40
3830	O=-1:K=K-1:IF I=J RETURN
3840	O=O+1:IF O=4 GOSUB 3880 :RETURN
3850	IF D$(I,O)=D$(J,O) GOTO 3840
3860	IF D$(J,O)<D$(I,O) LET K=K+1
3870	RETURN
3880	IF I<J LET K=K+1
3890	IF L OR I>J RETURN
3900	BEEP 1,255,200
3910	CLS :PRINT "Doppelter Datensatz:":GOSUB 6300
3920	P=I:GOSUB 690
3930	PRINT " % sortiert":CURSOR 0,0:PRINT Z/D*100
3940	RETURN
3950	IF F1=0 GOTO 4390
3960	IF F2=0 GOTO 4170
3970	RESTORE 3990 :GOTO 7290
3990	DATA 1,"TRANSFER",2,"Sichern",4170,"Laden",4390,"MENU",70
4010	DATA 1,"Datei unsortiert !",2,"Sortieren",3410,"sofort sichern",4180
4020	DATA "MENU",4250
4060	DATA 1,"LADEN",2,"Diskette",4400,"Eingabe",3670
4070	DATA "MENU",70
4090	DATA 1,"alte Datei",2,"erhalten",4720,"loeschen",4480,"MENU
4100	DATA 4710
4120	DATA 1,"Speicher zu klein:",2,"Teil laden",4580,"neuer Filename"
4130	DATA 4880,"MENU",4700
4150	DATA 1,"alte Datei:",2,"sichern und loeschen",4170
4160	DATA "sofort loeschen",4470,"MENU",70
4170	IF F6 OR F7 OR G7 OR H7 RESTORE 4010 :F8=1:GOTO 7290
4180	CLEAR F8:D=10*G+10:Z=0
4190	GOSUB 4340 :USING "####.#"
4200	OPEN "X:"+F$+".ADB" FOR OUTPUT AS #2
4210	PRINT #2,G,F6,F7,FP:PRINT 0;" % gesichert
4220	FOR I=0 TO G:FOR J=0 TO 6:PRINT #2,D$(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100:NEXT J
4230	FOR J=0 TO 2:PRINT #2,S(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100:NEXT J:NEXT I
4240	F2=1
4250	CLOSE :USING :IF FP=2 GOTO 120
4270	GOTO 70
4340	RESTORE 4365 :GOTO 7290
4350	INPUT "Filename: ";F$
4360	CLS :RETURN
4365	DATA 1,"CE-140F",1,"o.k.",4350,"MENU",70
4390	Z=0:RESTORE 4060 :GOTO 7290
4400	GOSUB 4340
4410	OPEN "X:"+F$+".ADB" FOR INPUT AS #3
4420	INPUT #3,U,V,W,A:D=10*U+10
4440	E=U*192+341
4450	IF A=FP AND M-G>U RESTORE 4090 :GOTO 7290
4480	ERASE D$,S
4490	M=INT ((MEM -727)/192):IF M>255 LET M=255
4500	PRINT "frei:":PRINT STR$ (MEM -727);" Bytes"
4510	IF MEM $="D" PRINT "Bitte eingeben:":PRINT "SETMEM ";CHR$ 34;"B";CHR$ 34;" ";CHR$ 91;
4515	IF MEM $="D" PRINT "ENTER";CHR$ 93:WAIT :PRINT "",CHR$ 91+"DEF"+CHR$ 93+" "+CHR$ 91+"C"+CHR$ 93
4516	"C"WAIT 0
4520	IF F9 GOSUB 6300 :GOSUB 4840 :GOTO 4580
4530	PRINT "Neue Datei:":PRINT STR$ E;" Bytes":GOSUB 6300
4560	IF U>M RESTORE 4120 :GOTO 7290
4570	IF M-U>5 GOSUB 4820
4580	CURSOR 5,1:PRINT "bitte Geduld
4590	DIM D$(M,6)*24,S(M,2):F1=1:F2=1:CLS
4600	IF F9 RETURN
4605	Z=0:USING "####.#":PRINT 0;" % geladen"
4610	FOR I=0 TO U:FOR J=0 TO 6
4620	INPUT #3,D$(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100
4640	NEXT J:FOR J=0 TO 2
4650	INPUT #3,S(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100
4670	NEXT J:NEXT I
4680	F6=V:F7=W:G=U:FP=A
4690	IF M<U LET F7=1
4700	CLOSE :USING
4710	GOTO 70
4720	Z=0:USING "####.#":PRINT 0;" % angehaengt"
4725	FOR I=G+1 TO G+U+1
4730	FOR J=0 TO 6
4740	INPUT #3,D$(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100
4760	NEXT J:FOR J=0 TO 2
4770	INPUT #3,S(I,J):Z=Z+1:CURSOR 0,0:PRINT Z/D*100
4790	NEXT J:NEXT I
4800	G=G+U+1:CLOSE :F7=1:CLS :GOTO 3690
4820	PRINT "Nicht benoetigt:":PRINT STR$ (MEM -727-E);" Bytes"
4830	PRINT "entspr. ";STR$ (M-U);" Datensaetze":GOSUB 6300
4840	Z=0:PRINT "Reservieren:":PRINT " Bytes":CURSOR 0,1:INPUT Z
4850	CLS :IF Z>MEM -727-E BEEP 1,255,200:GOTO 4840
4860	M=INT ((MEM -727-Z)/192):IF M>255 LET M=255
4870	RETURN
4880	CLOSE :GOTO 4400
4890	RESTORE 4910 :GOTO 7290
4910	DATA 1,"OPTIONEN",4,"Notizen",4930,"Status",5390,"Crypto
4920	DATA 5620,"Kalender",6610,"MENU",70
4930	RESTORE 4950 :GOTO 7290
4950	DATA 1,"NOTIZEN",5,"Ausgabe",4970,"Notieren",5070,"Loeschen",5110
4960	DATA "Sichern",5250,"Laden",5300,"MENU",70
4970	IF C4=0 GOTO 5380
4980	IF C4=1 LET K=0:GOTO 5030
4990	RESTORE 5010 :GOTO 7290
5010	DATA 1,"AUSGABE",C4-1,N$(0),5030,N$(1),5030,N$(2),5030
5020	DATA N$(3),5030,N$(4),5030,N$(5),5030
5030	Z=K:GOSUB 6310 :IF C1<>3 PRINT =LPRINT :IF C1=1 CONSOLE 24
5040	PRINT N$(Z):IF C1=3 GOSUB 6300
5050	PRINT =PRINT :CONSOLE 39
5060	GOTO 70
5070	IF C4=6 BEEP 1,255,100:PRINT "Notizspeicher voll !":GOSUB 6300 :GOTO 4930
5080	PRINT "Notiz Nr. ";STR$ (C4+1);" von max. 6":INPUT N$(C4):C4=C4+1
5090	POKE 12348,16:CLS
5100	GOTO 70
5110	IF C4=0 GOTO 5380
5120	IF C4=1 LET K=0:GOTO 5170
5130	RESTORE 5150 :GOTO 7290
5150	DATA 1,"LOESCHEN",C4-1,N$(0),5170,N$(1),5170,N$(2),5170
5160	DATA N$(3),5170,N$(4),5170,N$(5),5170
5170	Z=K:PRINT N$(Z):GOSUB 6300
5180	RESTORE 5200 :GOTO 7290
5200	DATA 1,">>> ACHTUNG <<<",2,"NOTIZEN",4930,"MENU",70
5210	DATA "Notiz loeschen",5220
5220	C4=C4-1:IF Z=C4 LET N$(Z)="":GOTO 4930
5230	N$(Z)=N$(C4):N$(C4)=""
5240	GOTO 4930
5250	IF C4=0 GOTO 5380
5260	GOSUB 4340
5270	OPEN "X:"+F$+".NTZ" FOR OUTPUT AS #4
5280	PRINT #4,C4,N$(*):CLOSE
5290	GOTO 70
5300	IF C4 RESTORE 5320 :GOTO 7290
5320	DATA 1,">>> ACHTUNG <<<",2,"NOTIZEN",4930,"MENU",70
5330	DATA "alle Notizen loeschen",5340
5340	GOSUB 4340
5350	OPEN "X:"+F$+".NTZ" FOR INPUT AS #5
5360	INPUT #5,C4,N$(*):CLOSE
5370	GOTO 4930
5380	PRINT "Keine Notiz !":GOSUB 6300 :GOTO 70
5390	GOSUB 6310
5400	IF C1<3 PRINT =LPRINT
5410	PRINT "MIKESOFT":PRINT "Adressdatenbanksystem":PRINT "Copyright 1991"
5420	PRINT "by M. Janssen":IF C1=3 GOSUB 6300
5430	PRINT "statischer RAM-Bedarf:":PRINT "20712 Bytes":PRINT "dynamischer RAM-Bedarf:
5440	WAIT :PRINT "192 Bytes je Datensatz":WAIT 0:CLS
5450	PRINT "freier Speicher:":PRINT STR$ MEM ;" Bytes"
5460	IF C1=3 GOSUB 6300
5470	IF F1=0 GOTO 5550
5480	PRINT STR$ (G+1);" von ";STR$ (M+1);" moeglichen":PRINT "Datensaetzen belegt"
5490	IF C1=3 GOSUB 6300
5500	IF F2=0 PRINT "Datei nicht gesichert !"
5510	IF F7 PRINT "Datei ist unsortiert !":GOTO 5530
5520	IF F6 PRINT STR$ F6;" neue Datensaetze":PRINT "noch einzusortieren"
5530	IF F2=0 OR F6 OR F7 AND C1=3 GOSUB 6300
5540	GOTO 5570
5550	PRINT "Keine Datei !":IF C1=3 GOSUB 6300
5560	PRINT STR$ (C4-1);" von max. 6 Notizen":PRINT "belegt":IF C1=3 GOSUB 6300
5570	IF F PPRINT "Aktuelle Datei
5580	ON FP GOTO 5600 ,5610
5590	PRINT =PRINT :GOTO 70
5600	PRINT "mit Password geschuetzt!":GOTO 5590
5610	PRINT "codiert !":GOTO 5590
5620	IF FP GOTO 6000
5630	IF F1=0 PRINT "Keine Datei !":GOSUB 6300 :GOTO 40
5640	RESTORE 5660 :GOTO 7290
5660	DATA 1,"DATENSCHUTZ",2,"Password",5680,"Codieren",5710
5670	DATA "MENU",70
5680	PRINT "Password:":GOSUB 6110
5690	P$(0)=M$(0)
5700	FP=1:GOTO 70
5710	PRINT "ACHTUNG: Fehlerhafter Decodierungsversuch be- wirkt Datenverlust !"
5720	GOSUB 6300 :RESTORE 5800 :GOTO 7290
5730	PRINT "Datei ";
5740	IF FP PRINT "decodieren:":GOTO 5760
5750	PRINT "codieren"
5760	PRINT "1. Password:":GOSUB 6110
5770	P$(0)=M$(0):PRINT "2. Password:":GOSUB 6110 :IF M$(0)=P$(0) BEEP 1,255,100:GOTO 5770
5780	FOR I=1 TO 2:P$(0)=P$(0)+P$(0):M$(0)=M$(0)+M$(0):NEXT I
5800	DATA 0,1,"Abbruch",120,"o.k.",5730
5810	Z=0:D=7*(G+1):USING "####.#":PRINT 0;" % ";
5812	IF FP PRINT "decodiert":GOTO 5820
5815	PRINT "codiert
5820	T$(0)="":FOR I=1 TO 24
5830	A=ASC MID$ (P$(0),I,1):B=ASC MID$ (M$(0),I,1)
5840	T$(0)=T$(0)+CHR$ (AOR BAND NOT (AAND B))
5850	NEXT I:M$(0)="":P$(0)=T$(0)
5860	FOR I=0 TO G:FOR J=0 TO 6
5870	IF D$(I,J)="" GOTO 5930
5880	T$(0)=""
5890	FOR K=1 TO LEN D$(I,J)
5900	A=ASC MID$ (P$(0),K,1):B=ASC MID$ (D$(I,J),K,1)
5910	T$(0)=T$(0)+CHR$ (AOR BAND NOT (AAND B))
5920	NEXT K:D$(I,J)=T$(0)
5930	Z=I*7+J:CURSOR 0,0:PRINT Z/D*100
5940	NEXT J:NEXT I
5950	M$(0)="":P$(0)="":T$(0)="":FP=ABS (FP-2):USING
5960	IF FP RESTORE 5990 :GOTO 7290
5970	GOTO 40
5990	DATA 0,1,"Codiert sichern",4170,"ENDE",120
6000	ON FP GOTO 6010 ,5710
6010	PRINT "Password:":FOR I=1 TO 3:GOSUB 6110 :CLS
6020	IF M$(0)=P$(0) LET I=3:FP=0:GOTO 6040
6030	BEEP 1,255,100:PRINT I;" falsches Password !"
6040	NEXT I
6050	ON FP+1 GOTO 6060 ,160
6060	RESTORE 6080 :GOTO 7290
6080	DATA 1,"Passwordschutz",1,"erhalten",6090,"beenden",6100
6090	FP=1:GOTO 50
6100	P$(0)="":GOTO 50
6110	M$(0)="":PRINT "?"
6120	T=ASC INKEY$ :IF T=0 GOTO 6120
6130	BEEP 1,1,25
6140	IF T=13 GOTO 6200
6150	IF T=15 AND LEN M$(0)>0 LET M$(0)=LEFT$ (M$(0),LEN M$(0)-1):GOTO 6120
6160	IF T=2 CLS :PRINT "neue Eingabe !":GOTO 6110
6170	IF T<32 OR T>122 AND T<>251 AND T<>252 BEEP 1,255,100:GOTO 6120
6180	M$(0)=M$(0)+CHR$ T
6190	IF LEN M$(0)<16 GOTO 6120
6200	CLS :IF LEN M$(0)<6 BEEP 1,255,100:PRINT "Password zu kurz !":GOTO 6110
6210	IF FP=1 RETURN
6220	PRINT "Kontrolleingabe:":PRINT "?":FOR I=1 TO LEN M$(0)
6230	T=ASC INKEY$ :IF T=0 GOTO 6230
6240	BEEP 1,1,25
6250	IF T=15 LET I=I-1:GOTO 6230
6260	IF T=2 LET I=1:PRINT "neue Eingabe !":GOTO 6230
6270	IF T<>ASC MID$ (M$(0),I,1) BEEP 1,255,100:PRINT "Fehler !":I=16:NEXT I:GOSUB 6300 :CLS :GOTO 6110
6280	NEXT I:CLS :RETURN
6290	PRINT "Eintraege nur":PRINT "von ";D$(S(0,L),L):PRINT "bis ";D$(S(G,L),L):PRINT "vorhanden
6300	WAIT :CURSOR 17,3:PRINT CHR$ 91;"ENTER";CHR$ 93:WAIT 0:CLS :RETURN
6310	CLOSE #1:RESTORE 6400 :GOTO 7290
6320	C1=1:PRINT "CE-140P";
6330	GOTO 6350
6340	C1=2:PRINT "CE-126P";
6350	PRINT " o.k. ?":GOSUB 6300
6360	IF C1=1 OPEN :LPRINT CHR$ 27+"@
6370	RETURN
6380	C1=3:RETURN
6400	DATA 1,"ZIEL",2,"CE-140P (inkjet)",6320,"CE-126P (thermo)",6340
6410	DATA "Display",6380
6420	PRINT "Text eingeben:":PRINT CHR$ 91;"ENTER";CHR$ 93;" = ";
6430	IF LEN T$(0)>14 PRINT LEFT$ (T$(0),10);" ...":GOTO 6460
6440	IF ASC T$(0)<33 PRINT "<SPC>":GOTO 6460
6450	PRINT T$(0)
6460	INPUT T$(0)
6470	POKE 12348,16:CLS
6480	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
6550	DATA 1,"EINGABEFEHLER",1,"o.k.",6520,"Hilfe",6560
6560	PRINT "Text mit Kleinbuchstaben":PRINT "Abkuerzungen mit ";CHR$ 34;".";CHR$ 34
6570	PRINT "hinter dem 1. Buchstaben":GOSUB 6300 :PRINT "Daten: TT.MM.JJJJ"
6580	PRINT "Freibleibende Felder mit";CHR$ 91;"ENTER";CHR$ 93;" quittieren
6590	GOSUB 6300 :GOTO 6520
6600	DATA 31,28+S,31,30,31,30,31,31,30,31,30,31
6610	D=1:INPUT "Monat: ";D
6620	IF D<1 OR D>12 BEEP 1,255,100:GOTO 6610
6630	E=1991:INPUT "Jahr : ";E
6640	IF E<1000 BEEP 1,255,100:GOTO 6630
6650	CLS :T$(0)="JANFEBMARAPRMAIJUNJULAUGSEPOKTNOVDEZ
6660	FOR I=1 TO 3:CURSOR 1,I-1:PRINT MID$ (T$(0),3*D+I-3,1):NEXT I
6670	CURSOR 0,3:PRINT RIGHT$ (STR$ E,2):CURSOR 3,0:PRINT "Mo Di Mi Do Fr Sa So
6680	LINE (20,0)-(149,6),X,BF:LINE (3,0)-(19,31),X,BF
6690	A=INT (E/100):B=E-A*100:Z=35+INT (1.25*(B-1))+INT (A/4)-2*A
6700	S=0:IF B/4=INT (B/4) LET S=1:IF B=0 AND A/4=INT (A/4) CLEAR S
6710	RESTORE 6600 :IF D=1 GOTO 6730
6720	FOR I=1 TO D-1:READ N:Z=Z+N:NEXT I
6730	READ N:O=Z-INT (Z/7)*7
6740	FOR I=1 TO 21-O
6750	Y=INT ((I+O-1)/7)+1:X=(I+O-(Y-1)*7)*3+(I<10)
6760	CURSOR X,Y:PRINT STR$ I
6770	NEXT I
6780	IF F1=0 GOTO 6880
6790	M$(0)="01.":IF D<10 LET M$(0)=M$(0)+"0"
6800	M$(0)=M$(0)+STR$ D:GOSUB 370
6810	IF VAL MID$ (D$(S(R,2),5),4,2)<>D GOTO 6880
6820	C=VAL LEFT$ (D$(S(R,2),5),2)
6830	IF C>21-O GOTO 6880
6840	Y=INT ((C+O-1)/7)+1:X=(C+O-(Y-1)*7)*3+2
6850	CURSOR X,Y:PRINT "*"
6860	R=R+1:IF R>G GOTO 6880
6870	GOTO 6810
6880	IF C4=0 GOTO 6970
6890	FOR I=0 TO C4-1
6900	IF VAL N$(I)=0 GOTO 6960
6910	U=VAL LEFT$ (N$(I),2):V=VAL MID$ (N$(I),4,2):W=1991
6920	IF V<>D OR U>21-O GOTO 6960
6930	Y=INT ((U+O-1)/7)+1:X=(U+O-(Y-1)*7)*3+2
6940	CURSOR X,Y:IF POINT (X*6+8,Y*8+3) PRINT "+":GOTO 6960
6950	PRINT "!"
6960	NEXT I
6970	GOSUB 7250
6980	BEEP 1:WAIT :GPRINT :WAIT 0:LINE (23,6)-(23,31),R
6990	FOR I=1 TO N-21+O
7000	Y=INT ((I-1)/7)+1:X=(I-(Y-1)*7)*3
7010	CURSOR X,Y:PRINT STR$ (I+21-O);" ":NEXT I
7020	FOR I=N-20+O TO 21
7030	Y=INT ((I-1)/7)+1:X=(I-(Y-1)*7)*3
7040	CURSOR X,Y:PRINT " ":NEXT I
7050	IF F1=0 GOTO 7130
7060	M$(0)=STR$ (22-O)+".":IF D<10 LET M$(0)=M$(0)+"0"
7070	M$(0)=M$(0)+STR$ D:GOSUB 370
7080	IF VAL MID$ (D$(S(R,2),5),4,2)<>D GOTO 7130
7090	C=VAL LEFT$ (D$(S(R,2),5),2)-21+O:Y=INT ((C-1)/7)+1:X=(C-(Y-1)*7)*3+2
7100	CURSOR X,Y:PRINT "*"
7110	R=R+1:IF R>G GOTO 7130
7120	GOTO 7080
7130	IF C4=0 GOTO 7230
7140	FOR I=0 TO C4-1
7150	IF VAL N$(I)=0 GOTO 7220
7160	U=VAL LEFT$ (N$(I),2):V=VAL MID$ (N$(I),4,2):W=1991
7170	IF V<>D OR U<22-O GOTO 7220
7180	U=U-21+O
7190	Y=INT ((U-1)/7)+1:X=(U-(Y-1)*7)*3+2
7200	CURSOR X,Y:IF POINT (X*6+8,Y*8+3) PRINT "+":GOTO 7220
7210	PRINT "!"
7220	NEXT I
7230	GOSUB 7250 :BEEP 1:WAIT :GPRINT :WAIT 0
7240	GOTO 70
7250	FOR Y=11 TO 27 STEP 8:FOR X=38 TO 146 STEP 18
7260	IF POINT (X,Y) LINE (X+2,Y+4)-(X-15,Y-3),X,BF
7270	NEXT X:NEXT Y
7280	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 STR$ (I+1);"-";LEFT$ (M$(0),S+6-8*SGN Q):NEXT I
7350	FOR I=0 TO 9999:T=VAL INKEY$ :IF T=0 NEXT I
7355	IF T=0 CLS :GOTO 120
7360	I=9999:NEXT I:BEEP 1,8,100
7367	IF T>N+1 BEEP 1,255,100:GOTO 7350
7410	CLS :GOTO Z(T-1)
7430	DIM P$(0)*24,T$(0)*62,N$(5)*80,M$(0)*24,Z(8):C2=1
7440	RETURN
7450	U=0:IF F2 GOTO 3670
7460	RESTORE 7470 :GOTO 7290
7470	DATA 1,">>> ACHTUNG <<<",2,"alte Datei sichern",4170,"alte Datei loeschen
7480	DATA 3670,"MENU",70

Dokumentation ansehen
Programmspeicher-Image laden