home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
M.u.C.S. Disc 2000
/
MUCS2000.iso
/
sigisoft
/
adresso.v10
/
adresso1.bas
next >
Wrap
BASIC Source File
|
1997-10-09
|
16KB
|
331 lines
7 CLS
8 A$=STRING$(80,45)
9 PRINT A$
10 PRINT " ------- (c) 1990 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ------ "
11 print a$:print tab(35)"präsentiert"
13 print tab(30);:color 0,7:print" Adressenverwaltung ";
14 color 7,0
15 print: print tab(30)"--------------------"
16 print tab(30)"Adresso Version 1.0"
17 print tab(29)"----------------------"
19 print a$
20 print " Dieses Programm ist frei kopierbar (Public Domain)"
21 print " Jeder der dieses Programm benützt, sollte mir aber ein"
22 print " kleines Anerkennunshonorar von ca 5-10 DM zusenden."
23 print " sollten sich viele PD Anwender bei mir melden, so werde"
24 print " ich mit zimlicher Sicherheit noch viele weitere PD Programme"
25 print " von mir in Umlauf bringen."
90 print a$
99 print tab(27)" Bitte eine Taste drücken":beep
100 a$=inkey$:if a$="" then 100
1000 ON ERROR GOTO 3920
1010 let yy=0
1020 cls:let dd=0
1030 print string$(80,45)
1040 print " ------ (c) 1990 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ------- "
1050 print string$(80,45);
1060 color 0,7:LOCATE 5,1:print " Datum: ";date$;" Zeit: ";time$;" ";
1061 color 7,0
1062 PRINT:PRINT
1070 PRINT " ";:print string$(72,249)
1080 print " ";:print chr$(249);:print " Adresso Version 1.0 ";:print chr$(249)
1090 print " ";:print chr$(249);:print " =================== ";:print chr$(249)
1100 print " ";:PRINT CHR$(249);:PRINT " ";:PRINT CHR$(249)
1110 print " ";:print chr$(249);:print " [ D ] = Adressen Eingeben [ K ] = Datei löschen ";:print chr$(249)
1120 print " ";:print chr$(249);:print " [ E ] = Adressen Editieren [ F ] = Adressenverzeichniss ";:print chr$(249)
1130 print " ";:print chr$(249);:print " [ S ] = Adressen Suchen [ P ] = Adressen drucken ";:print chr$(249)
1140 print " ";:print chr$(249);:print " [ L ] = Adressen Löschen [ X ] = Programmende ";:print chr$(249)
1150 print " ";:PRINT CHR$(249);:PRINT " ";:PRINT CHR$(249)
1160 PRINT " ";:PRINT CHR$(249);:PRINT " ";:PRINT CHR$(249)
1170 PRINT " ";:PRINT STRING$(72,249)
1180 COLOR 0,7
1190 LOCATE 18,26:PRINT " Bitte wählen Sie aus ... "
1200 color 7,0
1210 a$=inkey$
1220 if a$="D" or a$="d" then goto 1320
1230 if a$="E" or a$="e" then goto 1750
1240 if a$="S" or a$="s" then goto 2150
1250 if a$="L" or a$="l" then goto 3600
1260 ON ERROR GOTO 3919
1270 if a$="K" or a$="k" then kill "ADRESSEN.DAT"
1280 IF A$="F" OR A$="f" then goto 3120
1290 if a$="P" or a$="p" then goto 3370
1300 if a$="X" or a$="x" then goto 3850
1310 goto 1060
1320 rem ----------- Arbeitsmaske -------------
1330 cls
1340 print
1350 print
1360 print
1370 print:print
1380 print "Satznr.:"
1390 print:print
1400 print "Name: Vorname:"
1410 print
1420 print
1430 print "Strasse: Postlz.:"
1440 print:print
1450 print "Ort:"
1460 print
1470 print
1480 print
1490 print "Telefon:"
1540 if xx=1 or yy=1 then return
1570 rem ---------- Adressen eingeben ---------
1580 let xx=0
1590 open "ADRESSEN.DAT" AS #1 LEN=80
1600 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
1610 color 0,7:LOCATE 2,1:PRINT " Adresso V 1.0 Adressenverwaltung (c) 1990 by S.Hübner ":color 7,0
1620 LOCATE 3,3:PRINT "Adressen eingeben":let satz%=lof(1)/80
1630 locate 23,1:print "Letzte Satznr.:";satz%
1640 locate 23,27:print "RETURN = Menü"
1650 locate 23,50:print "Zeit.";time$:beep
1660 satz%=satz%+1:code%=satz%:locate 6,11:print "";satz%
1670 locate 9,8:input "",n$:if n$="" then close #1:goto 1020
1671 locate 9,42:input "",v$
1680 locate 12,11:input "",s$:locate 12,42:input "",po$
1690 locate 15,7:input "",o$
1700 locate 19,11:input "",t$
1710 lset a$=n$:lset b$=v$:lset c$=s$:lset D$=po$:lset e$=o$:lset f$=t$
1720 put #1,code%
1730 close #1
1740 goto 1320
1750 rem -------- Adressen editieren ----------
1760 let xx=1
1770 open "ADRESSEN.DAT" AS #1 LEN=80
1780 LET CODE%=LOF(1)/80
1790 IF CODE%=0 THEN CLOSE #1:LET XX=0:BEEP:GOTO 1020
1800 GOSUB 1320
1810 FIELD #1,13 AS N$,14 AS V$,18 AS S$,5 AS PO$,18 AS O$,12 AS T$
1820 color 0,7:LOCATE 2,1:PRINT " Adresso V 1.0 Adressenverwaltung (c) 1990 by S.Hübner ":color 7,0
1830 locate 3,3:print "Adressen editieren":locate 23,1:print "Letzte Satznr.";code%:locate 23,27:print "RETURN = Menü":locate 23,50:print "Zeit.";time$
1840 Locate 6,26:print "Welcher Name soll editiert werden?"
1850 locate 9,10:input "",na$:locate 9,44:input "",vo$
1860 for i=1 to code%
1870 get #1,i
1880 if left$(na$,3)=left$(n$,3) and left$(vo$,4)=left$(v$,4) goto 1900 ELSE GOTO 1890
1881 NEXT I
1890 close #1:let xx=0:goto 1020
1900 locate 6,11:print i:locate 9,10:print n$:locate 9,44:print v$:locate 12,13:print s$
1910 locate 12,44:print po$:locate 15,9:print o$
1920 locate 19,13:print t$
1930 color 0,7:locate 6,26:print "Welches Element soll editiert werden?":locate 8,68:print "N = Name ":locate 9,68:print "V = Vorname":locate 10,68:print "S = Strasse"
1940 locate 11,68:print "P = Postl.:":locate 12,68:print "O = Ort ":locate 13,68:print "T = Telefon"
1950 locate 15,68:input "Element:",w$:color 7,0
1960 if w$="N" or w$="n" then goto 2030
1970 if w$="V" or w$="v" then goto 2040
1980 if w$="S" or w$="s" then goto 2050
1990 if w$="P" or w$="p" then goto 2060
2000 if w$="O" or w$="o" then goto 2070
2010 if w$="T" or w$="t" then goto 2080
2020 close #1:let xx=0:goto 1020
2030 locate 9,8:input "",n$:goto 2090
2040 locate 9,42:input "",v$:goto 2090
2050 locate 12,11:input "",s$:goto 2090
2060 locate 12,42:input "",po$:goto 2090
2070 locate 15,7:input "",o$:goto 2090
2080 locate 19,11:input "",t$:goto 2090
2090 open "ADRESSEN.DAT" AS #2 LEN=80
2100 FIELD #2,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
2110 LSET A$=N$:LSET B$=V$:LSET C$=S$:LSET D$=PO$:LSET E$=O$:LSET F$=T$
2120 PUT #2,I
2130 CLOSE #1:CLOSE #2:LET XX=0:GOTO 1020
2140 GET #1,I
2150 rem ---------- Adressen suchen -----------
2160 cls:open "ADRESSEN.DAT" AS #1 LEN=80
2170 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
2180 LET SATZ%=LOF(1)/80
2190 IF SATZ%=0 THEN CLOSE #1:BEEP:GOTO 1020
2200 LOCATE 23,1:PRINT "RETURN = Menü":LOCATE 23,20:PRINT "Gesamtadressen:";satz%
2210 locate 1,1 :print :print "Nach welchen Kriterium soll gesucht werden?"
2220 print :print
2230 print " [ 1 ] ................ Name "
2240 print " [ 2 ] ................ Vorname "
2250 print " [ 3 ] ................ Strasse "
2260 print " [ 4 ] ................ Postleitz. "
2270 print " [ 5 ] ................ Ort "
2280 print " [ 6 ] ................ Telefon ":print:print
2290 print "Kriterium:":locate 13,12:input "",k%
2300 if k%=1 then goto 2390
2310 if k%=2 then goto 2500
2320 if k%=3 then goto 2630
2330 if k%=4 then goto 2760
2340 if k%=5 then goto 2880
2350 if k%=6 then goto 2990
2360 if k%>6 then cls:BEEP:PRINT:PRINT "Ungültige Eingabe":close #1
2370 if k%=0 then close #1:goto 1020
2380 for i=1 to 900:next i:goto 1020
2390 locate 13,22:print "Name:":locate 13,27:input "",su$: let vv$ = left$(su$,3)
2400 cls: let code% = lof(1)/80
2410 print "Name Vorname Strasse PLZ ORT Telefon ":print
2420 for i=1 to code%
2430 get #1,i:let xx$=left$(a$,3)
2440 if vv$=xx$ then print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let dd=dd+1
2450 next i
2460 print :print :print dd;"Adresse(n) vorhanden"
2470 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
2480 a$=inkey$:if a$="" then 2480
2490 goto 1020
2500 locate 13,22:print "Vorname:":locate 13,30:input "",su$:let vv$=left$(su$,3)
2510 cls:let code% = lof(1)/80
2520 print "Name Vorname Strasse PLZ ORT Telefon ":print
2530 for i=1 to code%
2540 get #1,i:let xx$=left$(b$,3)
2550 if vv$=xx$ then print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let dd=dd+1
2560 next i
2570 print:print:print dd;"Adresse(n) vorhanden"
2580 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
2590 a$=inkey$:if a$="" then 2590
2600 goto 1020
2610 a$=inkey$:if a$="" then 2610
2620 goto 1020
2630 locate 13,22:print "Strasse:":locate 13,30:input "",su$:let vv$=left$(su$,3)
2640 cls:let code%=lof(1)/80
2650 print "Name Vorname Strasse PLZ ORT Telefon ":print
2660 for i=1 to code%
2670 get #1,i:let xx$=left$(c$,3)
2680 if vv$=xx$ then print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let dd=dd+1
2690 next i
2700 print:print:print dd;"Adresse(n) vorhanden"
2710 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
2720 a$=inkey$:if a$="" then 2720
2730 goto 1020
2740 a$=inkey$:if a$="" then 2740
2750 goto 1020
2760 locate 13,22:print "Postl.":locate 13,29:input "",su$:let vv$=left$(su$,3)
2770 cls:let code%=lof(1)/80
2780 print "Name Vorname Strasse PLZ ORT Telefon ":print
2790 for i=1 to code%
2800 get #1,i:let xx$=left$(d$,3)
2810 if vv$=xx$ then print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let dd=dd+1
2820 next i
2830 print:print:print dd;"Adresse(n) vorhanden"
2840 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
2850 a$=inkey$:if a$="" then 2850
2860 goto 1020
2870 if vv$=xx$ then print tab(1);LEFT$(A$,13);LEFT$(B$,14);LEFT$(C$,18);LEFT$(D$,5);LEFT$(E$,18);LEFT$(F$,12):LET DD=DD+1
2880 LOCATE 13,22:PRINT "Ort:":locate 13,26:input "",su$:let vv$=left$(su$,3)
2890 cls:let code%=lof(1)/80
2900 print "Name Vorname Strasse PLZ ORT Telefon ":print
2910 for i=1 to code%
2920 get #1,i:let xx$=left$(e$,3)
2930 if vv$=xx$ then print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let dd=dd+1
2940 next i
2950 print:print:print dd;"Adresse(n) vorhanden"
2960 let xx=0:close #1:locate 22,30:print"Bitte eine Taste drücken":beep
2970 a$=inkey$:if a$="" then 2970
2980 goto 1020
2990 locate 13,22:print "Telefon:":locate 13,30:input "",su$:let vv$=left$(su$,3)
3000 cls:let code%=lof(1)/80
3010 print "Name Vorname Strasse PLZ ORT Telefon ":print
3020 for i=1 to code%
3030 get #1,i:let xx$=left$(f$,3)
3040 if vv$=xx$ then print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let dd=dd+1
3050 next i
3060 print:print:print dd;"Adresse(n) vorhanden"
3070 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
3080 a$=inkey$:if a$="" then 3080
3090 goto 1020
3100 a$=inkey$:if a$="" then 3100
3110 goto 1020
3120 rem -------- Adressenverzeichnis ---------
3130 cls:open "ADRESSEN.DAT" AS #1 LEN=80
3140 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
3150 LET CODE%=LOF(1)/80:IF CODE%=0 THEN CLOSE #1:BEEP:GOTO 1020
3160 FOR I=1 TO CODE%
3170 GET #1,I
3180 LET S$(I)=a$+b$+c$:next i
3190 for i=1 to code%-1
3200 if s$(i)<s$(i+1) then 3250
3210 s$(0)=s$(i+1)
3220 c=i
3230 s$(c+1)=s$(c):c=c-1:if s$(0)<s$(c) then 3230
3240 s$(c+1)=s$(0)
3250 next i
3260 i=1:j=1
3270 print "Name Vorname Strasse PLZ ORT Telefon ":print
3280 get #1,i
3290 if a$+b$+c$=s$(j) then goto 3320
3300 let i=i+1
3310 goto 3280
3320 print tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let j=j+1:let i=1:if j=code%+1 goto 3330 else goto 3280
3330 for j=1 to 2:print:next j:print "Gesamtadressen:";code%
3340 close #1:locate 22,30:print "Bitte eine Taste drücken":beep
3350 a$=inkey$:if a$="" then 3350
3360 goto 1020
3370 rem --- Adressenverzeichniss drucken -----
3380 open "ADRESSEN.DAT" AS #1 LEN=80
3390 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
3400 LET CODE%=lof(1)/80
3410 for i=1 to code%
3420 get #1,i
3430 let s$(i)=a$+b$+c$:next i
3440 for i=1 to code%-1
3450 if s$(i)<s$(i+1) then 3490
3460 s$(0)=s$(i+1):c=i
3470 s$(c+1)=s$(c):c=c-1:if s$(0)<s$(c) then 3470
3480 s$(c+1)=s$(0)
3490 next i
3500 let code%=lof(1)/80
3510 lprint "Adresso V1.0 Adressenverzeichnis":lprint:lprint:lprint
3520 lprint "Name Vorname Strasse PLZ ORT Telefon ":lprint:lprint
3530 i=1:j=1
3540 get #1,i
3550 if a$+b$+c$=s$(j) then goto 3580
3560 let i=i+1
3570 GOTO 3540
3580 lprint tab(1);left$(a$,13);left$(b$,14);left$(c$,18);left$(d$,5);left$(e$,18);left$(f$,12):let j=j+1:let i=1:if j=code%+1 goto 3590 else 3540
3590 lprint:lprint:lprint:lprint:lprint:lprint"Gesamtadressen:";code%;" Zeit:";time$:close #1:goto 1020
3600 rem ---------- Adressen löschen ----------
3610 cls:let yy=1
3620 open "ADRESSEN.DAT" AS #1 LEN=80
3630 FIELD #1,13 AS N$,14 AS V$,18 AS S$,5 AS PO$,18 AS O$,12 AS T$
3640 LET SATZ%=LOF(1)/80:IF SATZ%=0 THEN CLOSE #1:LET YY=0:BEEP:GOTO 1020
3650 GOSUB 1320:color 0,7:LOCATE 2,1:PRINT " Adresso V 1.0 Adressenverwaltung (c) 1990 by S.Hübner ":color 7,0
3660 locate 3,3:print "Adressen löschen"
3670 locate 23,1:print "Letzte Satznr.:";satz%
3680 locate 23,27:print "RETURN = Menü"
3690 locate 23,50:print "Zeit:";time$
3700 locate 6,28:print "Welcher Name soll gelöscht werden?"
3710 locate 9,10:input "",na$:locate 9,44:input "",vo$:let j=1:let i=1
3720 if i=satz%+1 goto 3750
3730 get #1,i
3740 if left$(na$,3)=left$(n$,3) and left$(vo$,4)=left$(v$,4) goto 3840 else goto 3790
3750 close #1:yy=1:if satz%=1 then kill "ADRESSEN.DAT":GOTO 1020
3760 KILL "ADRESSEN.DAT"
3770 NAME "ZWISCHEN.DAT" AS "ADRESSEN.DAT"
3780 GOTO 1020
3790 OPEN "ZWISCHEN.DAT" AS #2 LEN=80
3800 FIELD #2,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
3810 LSET A$=N$:LSET B$=V$:LSET C$=S$:LSET D$=PO$:LSET E$=O$:LSET F$=T$
3820 PUT #2,J
3830 LET J=J+1
3840 LET I=I+1:CLOSE #2:GOTO 3720
3850 CLS:FOR I=1 TO 4:PRINT:NEXT I
3890 CLOSE #1:CLOSE #2
3900 cls:a$=string$(80,45):print a$
3901 PRINT " ------- (c) 1990 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ------ "
3902 print a$:print tab(35)"präsentiert"
3903 print tab(30);:color 0,7:print" Adressenverwaltung ";
3904 color 7,0
3905 print: print tab(30)"--------------------"
3906 print tab(30)"Adresso Version 1.0"
3907 print tab(29)"----------------------"
3908 print a$
3909 print " Dieses Programm ist frei kopierbar (Public Domain)"
3910 print " Jeder der dieses Programm benützt, sollte mir aber ein"
3911 print " kleines Anerkennunshonorar von ca 5-10 DM zusenden."
3912 print " sollten sich viele PD Anwender bei mir melden, so werde"
3913 print " ich mit zimlicher Sicherheit noch viele weitere PD Programme"
3914 print " von mir in Umlauf bringen."
3915 print a$
3916 print tab(27)" Bitte eine Taste drücken":beep
3917 a$=inkey$:if a$="" then 3917
3918 system
3919 REM ---------- FEHLERROUTINE -----------
3920 LOCATE 20,30:PRINT " !!! FEHLER !!!"
3930 locate 21,30:print "Bitte eine Taste drücken"
3931 a$=inkey$:if a$="" then goto 3931
3940 REM
3950 CLOSE #1:CLOSE #2:GOTO 1020