home *** CD-ROM | disk | FTP | other *** search
/ M.u.C.S. Disc 2000 / MUCS2000.iso / sigisoft / adresso.v10 / adresso1.bas next >
BASIC Source File  |  1997-10-09  |  16KB  |  331 lines
  1. 7 CLS
  2. 8 A$=STRING$(80,45)
  3. 9 PRINT A$
  4. 10 PRINT " ------- (c) 1990 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ------ "
  5. 11 print a$:print tab(35)"präsentiert"
  6. 13 print tab(30);:color 0,7:print" Adressenverwaltung ";
  7. 14 color 7,0
  8. 15 print: print tab(30)"--------------------"
  9. 16 print tab(30)"Adresso  Version 1.0"
  10. 17 print tab(29)"----------------------"
  11. 19 print a$
  12. 20 print "               Dieses Programm ist frei kopierbar (Public Domain)"
  13. 21 print "             Jeder der dieses Programm benützt, sollte mir aber ein"
  14. 22 print "               kleines Anerkennunshonorar von ca 5-10 DM zusenden."
  15. 23 print "            sollten sich viele PD Anwender bei mir melden, so werde"
  16. 24 print "         ich mit zimlicher Sicherheit noch viele weitere PD Programme"
  17. 25 print "                            von mir in Umlauf bringen."
  18. 90 print a$
  19. 99 print tab(27)" Bitte eine Taste drücken":beep
  20. 100 a$=inkey$:if a$="" then 100
  21. 1000 ON ERROR GOTO 3920 
  22. 1010 let yy=0
  23. 1020 cls:let dd=0
  24. 1030 print string$(80,45)
  25. 1040 print " ------ (c) 1990 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ------- "
  26. 1050 print string$(80,45);
  27. 1060 color 0,7:LOCATE 5,1:print "           Datum:     ";date$;"                 Zeit:      ";time$;"            ";
  28. 1061 color 7,0
  29. 1062 PRINT:PRINT
  30. 1070 PRINT "    ";:print string$(72,249)
  31. 1080 print "    ";:print chr$(249);:print "                        Adresso Version 1.0                           ";:print chr$(249)
  32. 1090 print "    ";:print chr$(249);:print "                        ===================                           ";:print chr$(249)
  33. 1100 print "    ";:PRINT CHR$(249);:PRINT "                                                                      ";:PRINT CHR$(249)
  34. 1110 print "    ";:print chr$(249);:print "     [ D ] = Adressen Eingeben        [ K ] = Datei löschen           ";:print chr$(249)
  35. 1120 print "    ";:print chr$(249);:print "     [ E ] = Adressen Editieren       [ F ] = Adressenverzeichniss    ";:print chr$(249)
  36. 1130 print "    ";:print chr$(249);:print "     [ S ] = Adressen Suchen          [ P ] = Adressen drucken        ";:print chr$(249)
  37. 1140 print "    ";:print chr$(249);:print "     [ L ] = Adressen Löschen         [ X ] = Programmende            ";:print chr$(249)
  38. 1150 print "    ";:PRINT CHR$(249);:PRINT "                                                                      ";:PRINT CHR$(249)
  39. 1160 PRINT "    ";:PRINT CHR$(249);:PRINT "                                                                      ";:PRINT CHR$(249)
  40. 1170 PRINT "    ";:PRINT STRING$(72,249)
  41. 1180 COLOR 0,7
  42. 1190 LOCATE 18,26:PRINT " Bitte wählen Sie aus ... "
  43. 1200 color 7,0
  44. 1210 a$=inkey$
  45. 1220 if a$="D" or a$="d" then goto 1320
  46. 1230 if a$="E" or a$="e" then goto 1750
  47. 1240 if a$="S" or a$="s" then goto 2150
  48. 1250 if a$="L" or a$="l" then goto 3600
  49. 1260 ON ERROR GOTO 3919
  50. 1270 if a$="K" or a$="k" then kill "ADRESSEN.DAT"
  51. 1280 IF A$="F" OR A$="f" then goto 3120
  52. 1290 if a$="P" or a$="p" then goto 3370
  53. 1300 if a$="X" or a$="x" then goto 3850
  54. 1310 goto 1060
  55. 1320 rem ----------- Arbeitsmaske -------------
  56. 1330 cls
  57. 1340 print
  58. 1350 print 
  59. 1360 print 
  60. 1370 print:print
  61. 1380 print "Satznr.:"
  62. 1390 print:print
  63. 1400 print "Name:                          Vorname:"
  64. 1410 print
  65. 1420 print
  66. 1430 print "Strasse:                       Postlz.:"
  67. 1440 print:print
  68. 1450 print "Ort:"
  69. 1460 print
  70. 1470 print
  71. 1480 print
  72. 1490 print "Telefon:"
  73. 1540 if xx=1 or yy=1 then return
  74. 1570 rem ---------- Adressen eingeben ---------
  75. 1580 let xx=0
  76. 1590 open "ADRESSEN.DAT" AS #1 LEN=80
  77. 1600 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
  78. 1610 color 0,7:LOCATE 2,1:PRINT "    Adresso V 1.0                    Adressenverwaltung (c) 1990 by S.Hübner    ":color 7,0
  79. 1620 LOCATE 3,3:PRINT "Adressen eingeben":let satz%=lof(1)/80
  80. 1630 locate 23,1:print "Letzte Satznr.:";satz%
  81. 1640 locate 23,27:print "RETURN = Menü"
  82. 1650 locate 23,50:print "Zeit.";time$:beep
  83. 1660 satz%=satz%+1:code%=satz%:locate 6,11:print "";satz% 
  84. 1670 locate 9,8:input "",n$:if n$="" then close #1:goto 1020
  85. 1671 locate 9,42:input "",v$
  86. 1680 locate 12,11:input "",s$:locate 12,42:input "",po$
  87. 1690 locate 15,7:input "",o$
  88. 1700 locate 19,11:input "",t$
  89. 1710 lset a$=n$:lset b$=v$:lset c$=s$:lset D$=po$:lset e$=o$:lset f$=t$
  90. 1720 put #1,code%
  91. 1730 close #1
  92. 1740 goto 1320
  93. 1750 rem -------- Adressen editieren ----------  
  94. 1760 let xx=1
  95. 1770 open "ADRESSEN.DAT" AS #1 LEN=80
  96. 1780 LET CODE%=LOF(1)/80
  97. 1790 IF CODE%=0 THEN CLOSE #1:LET XX=0:BEEP:GOTO 1020
  98. 1800 GOSUB 1320
  99. 1810 FIELD #1,13 AS N$,14 AS V$,18 AS S$,5 AS PO$,18 AS O$,12 AS T$
  100. 1820 color 0,7:LOCATE 2,1:PRINT "    Adresso V 1.0                    Adressenverwaltung (c) 1990 by S.Hübner    ":color 7,0
  101. 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$
  102. 1840 Locate 6,26:print "Welcher Name soll editiert werden?"
  103. 1850 locate 9,10:input "",na$:locate 9,44:input "",vo$
  104. 1860 for i=1 to code%
  105. 1870 get #1,i
  106. 1880 if left$(na$,3)=left$(n$,3) and left$(vo$,4)=left$(v$,4) goto 1900 ELSE GOTO 1890 
  107. 1881 NEXT I
  108. 1890 close #1:let xx=0:goto 1020
  109. 1900 locate 6,11:print i:locate 9,10:print n$:locate 9,44:print v$:locate 12,13:print s$
  110. 1910 locate 12,44:print po$:locate 15,9:print o$
  111. 1920 locate 19,13:print t$
  112. 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"
  113. 1940 locate 11,68:print "P = Postl.:":locate 12,68:print "O = Ort    ":locate 13,68:print "T = Telefon"
  114. 1950 locate 15,68:input "Element:",w$:color 7,0
  115. 1960 if w$="N" or w$="n" then goto 2030
  116. 1970 if w$="V" or w$="v" then goto 2040
  117. 1980 if w$="S" or w$="s" then goto 2050
  118. 1990 if w$="P" or w$="p" then goto 2060
  119. 2000 if w$="O" or w$="o" then goto 2070
  120. 2010 if w$="T" or w$="t" then goto 2080
  121. 2020 close #1:let xx=0:goto 1020
  122. 2030 locate 9,8:input "",n$:goto 2090
  123. 2040 locate 9,42:input "",v$:goto 2090
  124. 2050 locate 12,11:input "",s$:goto 2090
  125. 2060 locate 12,42:input "",po$:goto 2090
  126. 2070 locate 15,7:input "",o$:goto 2090
  127. 2080 locate 19,11:input "",t$:goto 2090
  128. 2090 open "ADRESSEN.DAT" AS #2 LEN=80
  129. 2100 FIELD #2,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
  130. 2110 LSET A$=N$:LSET B$=V$:LSET C$=S$:LSET D$=PO$:LSET E$=O$:LSET F$=T$
  131. 2120 PUT #2,I
  132. 2130 CLOSE #1:CLOSE #2:LET XX=0:GOTO 1020
  133. 2140 GET #1,I
  134. 2150 rem ---------- Adressen suchen -----------
  135. 2160 cls:open "ADRESSEN.DAT" AS #1 LEN=80
  136. 2170 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
  137. 2180 LET SATZ%=LOF(1)/80
  138. 2190 IF SATZ%=0 THEN CLOSE #1:BEEP:GOTO 1020
  139. 2200 LOCATE 23,1:PRINT "RETURN = Menü":LOCATE 23,20:PRINT "Gesamtadressen:";satz%
  140. 2210 locate 1,1 :print :print "Nach welchen Kriterium soll gesucht werden?"
  141. 2220 print :print
  142. 2230 print "                  [ 1 ]   ................ Name          "
  143. 2240 print "                  [ 2 ]   ................ Vorname       "
  144. 2250 print "                  [ 3 ]   ................ Strasse       "
  145. 2260 print "                  [ 4 ]   ................ Postleitz.    "
  146. 2270 print "                  [ 5 ]   ................ Ort           "
  147. 2280 print "                  [ 6 ]   ................ Telefon       ":print:print
  148. 2290 print "Kriterium:":locate 13,12:input "",k%
  149. 2300 if k%=1 then goto 2390
  150. 2310 if k%=2 then goto 2500
  151. 2320 if k%=3 then goto 2630
  152. 2330 if k%=4 then goto 2760
  153. 2340 if k%=5 then goto 2880
  154. 2350 if k%=6 then goto 2990
  155. 2360 if k%>6 then cls:BEEP:PRINT:PRINT "Ungültige Eingabe":close #1
  156. 2370 if k%=0 then close #1:goto 1020
  157. 2380 for i=1 to 900:next i:goto 1020
  158. 2390 locate 13,22:print "Name:":locate 13,27:input "",su$: let vv$ = left$(su$,3)
  159. 2400 cls: let code% = lof(1)/80
  160. 2410 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  161. 2420 for i=1 to code%
  162. 2430 get #1,i:let xx$=left$(a$,3)
  163. 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
  164. 2450 next i
  165. 2460 print :print :print dd;"Adresse(n) vorhanden"
  166. 2470 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
  167. 2480 a$=inkey$:if a$="" then 2480
  168. 2490 goto 1020
  169. 2500 locate 13,22:print "Vorname:":locate 13,30:input "",su$:let vv$=left$(su$,3)
  170. 2510 cls:let code% = lof(1)/80
  171. 2520 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  172. 2530 for i=1 to code%
  173. 2540 get #1,i:let xx$=left$(b$,3)
  174. 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
  175. 2560 next i
  176. 2570 print:print:print dd;"Adresse(n) vorhanden"
  177. 2580 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
  178. 2590 a$=inkey$:if a$="" then 2590
  179. 2600 goto 1020
  180. 2610 a$=inkey$:if a$="" then 2610
  181. 2620 goto 1020
  182. 2630 locate 13,22:print "Strasse:":locate 13,30:input "",su$:let vv$=left$(su$,3)
  183. 2640 cls:let code%=lof(1)/80
  184. 2650 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  185. 2660 for i=1 to code%
  186. 2670 get #1,i:let xx$=left$(c$,3)
  187. 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
  188. 2690 next i
  189. 2700 print:print:print dd;"Adresse(n) vorhanden"
  190. 2710 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
  191. 2720 a$=inkey$:if a$="" then 2720
  192. 2730 goto 1020
  193. 2740 a$=inkey$:if a$="" then 2740
  194. 2750 goto 1020
  195. 2760 locate 13,22:print "Postl.":locate 13,29:input "",su$:let vv$=left$(su$,3)
  196. 2770 cls:let code%=lof(1)/80
  197. 2780 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  198. 2790 for i=1 to code%
  199. 2800 get #1,i:let xx$=left$(d$,3)
  200. 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
  201. 2820 next i
  202. 2830 print:print:print dd;"Adresse(n) vorhanden"
  203. 2840 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
  204. 2850 a$=inkey$:if a$="" then 2850
  205. 2860 goto 1020
  206. 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
  207. 2880 LOCATE 13,22:PRINT "Ort:":locate 13,26:input "",su$:let vv$=left$(su$,3)
  208. 2890 cls:let code%=lof(1)/80
  209. 2900 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  210. 2910 for i=1 to code%
  211. 2920 get #1,i:let xx$=left$(e$,3)
  212. 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
  213. 2940 next i
  214. 2950 print:print:print dd;"Adresse(n) vorhanden"
  215. 2960 let xx=0:close #1:locate 22,30:print"Bitte eine Taste drücken":beep
  216. 2970 a$=inkey$:if a$="" then 2970
  217. 2980 goto 1020
  218. 2990 locate 13,22:print "Telefon:":locate 13,30:input "",su$:let vv$=left$(su$,3)
  219. 3000 cls:let code%=lof(1)/80
  220. 3010 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  221. 3020 for i=1 to code%
  222. 3030 get #1,i:let xx$=left$(f$,3)
  223. 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
  224. 3050 next i
  225. 3060 print:print:print dd;"Adresse(n) vorhanden"  
  226. 3070 let xx=0:close #1:locate 22,30:print "Bitte eine Taste drücken":beep
  227. 3080 a$=inkey$:if a$="" then 3080
  228. 3090 goto 1020
  229. 3100 a$=inkey$:if a$="" then 3100
  230. 3110 goto 1020
  231. 3120 rem -------- Adressenverzeichnis ---------
  232. 3130 cls:open "ADRESSEN.DAT" AS #1 LEN=80
  233. 3140 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
  234. 3150 LET CODE%=LOF(1)/80:IF CODE%=0 THEN CLOSE #1:BEEP:GOTO 1020
  235. 3160 FOR I=1 TO CODE%
  236. 3170 GET #1,I
  237. 3180 LET S$(I)=a$+b$+c$:next i
  238. 3190 for i=1 to code%-1
  239. 3200 if s$(i)<s$(i+1) then 3250
  240. 3210 s$(0)=s$(i+1)
  241. 3220 c=i
  242. 3230 s$(c+1)=s$(c):c=c-1:if s$(0)<s$(c) then 3230
  243. 3240 s$(c+1)=s$(0)
  244. 3250 next i
  245. 3260 i=1:j=1
  246. 3270 print "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":print
  247. 3280 get #1,i
  248. 3290 if a$+b$+c$=s$(j) then goto 3320
  249. 3300 let i=i+1
  250. 3310 goto 3280
  251. 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
  252. 3330 for j=1 to 2:print:next j:print "Gesamtadressen:";code%
  253. 3340 close #1:locate 22,30:print "Bitte eine Taste drücken":beep
  254. 3350 a$=inkey$:if a$="" then 3350
  255. 3360 goto 1020
  256. 3370 rem --- Adressenverzeichniss drucken -----
  257. 3380 open "ADRESSEN.DAT" AS #1 LEN=80
  258. 3390 FIELD #1,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
  259. 3400 LET CODE%=lof(1)/80
  260. 3410 for i=1 to code%
  261. 3420 get #1,i
  262. 3430 let s$(i)=a$+b$+c$:next i
  263. 3440 for i=1 to code%-1
  264. 3450 if s$(i)<s$(i+1) then 3490
  265. 3460 s$(0)=s$(i+1):c=i
  266. 3470 s$(c+1)=s$(c):c=c-1:if s$(0)<s$(c) then 3470
  267. 3480 s$(c+1)=s$(0)
  268. 3490 next i
  269. 3500 let code%=lof(1)/80
  270. 3510 lprint "Adresso V1.0          Adressenverzeichnis":lprint:lprint:lprint
  271. 3520 lprint "Name         Vorname       Strasse           PLZ  ORT               Telefon    ":lprint:lprint
  272. 3530 i=1:j=1
  273. 3540 get #1,i
  274. 3550 if a$+b$+c$=s$(j) then goto 3580
  275. 3560 let i=i+1
  276. 3570 GOTO 3540
  277. 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
  278. 3590 lprint:lprint:lprint:lprint:lprint:lprint"Gesamtadressen:";code%;"     Zeit:";time$:close #1:goto 1020
  279. 3600 rem ---------- Adressen löschen ----------
  280. 3610 cls:let yy=1
  281. 3620 open "ADRESSEN.DAT" AS #1 LEN=80
  282. 3630 FIELD #1,13 AS N$,14 AS V$,18 AS S$,5 AS PO$,18 AS O$,12 AS T$
  283. 3640 LET SATZ%=LOF(1)/80:IF SATZ%=0 THEN CLOSE #1:LET YY=0:BEEP:GOTO 1020
  284. 3650 GOSUB 1320:color 0,7:LOCATE 2,1:PRINT "    Adresso V 1.0                    Adressenverwaltung (c) 1990 by S.Hübner    ":color 7,0
  285. 3660 locate 3,3:print "Adressen löschen"
  286. 3670 locate 23,1:print "Letzte Satznr.:";satz%
  287. 3680 locate 23,27:print "RETURN = Menü"
  288. 3690 locate 23,50:print "Zeit:";time$
  289. 3700 locate 6,28:print "Welcher Name soll gelöscht werden?"
  290. 3710 locate 9,10:input "",na$:locate 9,44:input "",vo$:let j=1:let i=1
  291. 3720 if i=satz%+1 goto 3750
  292. 3730 get #1,i
  293. 3740 if left$(na$,3)=left$(n$,3) and left$(vo$,4)=left$(v$,4) goto 3840 else goto 3790
  294. 3750 close #1:yy=1:if satz%=1 then kill "ADRESSEN.DAT":GOTO 1020
  295. 3760 KILL "ADRESSEN.DAT"
  296. 3770 NAME "ZWISCHEN.DAT" AS "ADRESSEN.DAT"
  297. 3780 GOTO 1020
  298. 3790 OPEN "ZWISCHEN.DAT" AS #2 LEN=80
  299. 3800 FIELD #2,13 AS A$,14 AS B$,18 AS C$,5 AS D$,18 AS E$,12 AS F$
  300. 3810 LSET A$=N$:LSET B$=V$:LSET C$=S$:LSET D$=PO$:LSET E$=O$:LSET F$=T$
  301. 3820 PUT #2,J
  302. 3830 LET J=J+1
  303. 3840 LET I=I+1:CLOSE #2:GOTO 3720
  304. 3850 CLS:FOR I=1 TO 4:PRINT:NEXT I
  305. 3890 CLOSE #1:CLOSE #2
  306. 3900 cls:a$=string$(80,45):print a$
  307. 3901 PRINT " ------- (c) 1990 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ------ "
  308. 3902 print a$:print tab(35)"präsentiert"
  309. 3903 print tab(30);:color 0,7:print" Adressenverwaltung ";
  310. 3904 color 7,0
  311. 3905 print: print tab(30)"--------------------"
  312. 3906 print tab(30)"Adresso  Version 1.0"
  313. 3907 print tab(29)"----------------------"
  314. 3908 print a$
  315. 3909 print "               Dieses Programm ist frei kopierbar (Public Domain)"
  316. 3910 print "             Jeder der dieses Programm benützt, sollte mir aber ein"
  317. 3911 print "               kleines Anerkennunshonorar von ca 5-10 DM zusenden."
  318. 3912 print "            sollten sich viele PD Anwender bei mir melden, so werde"
  319. 3913 print "         ich mit zimlicher Sicherheit noch viele weitere PD Programme"
  320. 3914 print "                            von mir in Umlauf bringen."
  321. 3915 print a$
  322. 3916 print tab(27)" Bitte eine Taste drücken":beep
  323. 3917 a$=inkey$:if a$="" then 3917
  324. 3918 system
  325. 3919 REM ---------- FEHLERROUTINE -----------
  326. 3920 LOCATE 20,30:PRINT " !!!    FEHLER     !!!"
  327. 3930 locate 21,30:print "Bitte eine Taste drücken"
  328. 3931 a$=inkey$:if a$="" then goto 3931
  329. 3940 REM
  330. 3950 CLOSE #1:CLOSE #2:GOTO 1020
  331.