home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 3 / 64er_Magazin_Sonderheft_03_86-03_1986_Markt__Technik_de_Side_A.d64 / datamaster (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  10KB  |  462 lines
  1. 5 fora=1to8:(NULL)a,"":next
  2. 6 (NULL)8,"[218]":(NULL)1,"[211]"
  3. 7 (NULL)1,15,5:(NULL)0,7,0:(NULL)4,7,0
  4. 10 cs=202
  5. 20 cz=205
  6. 30 cr=55464
  7. 40 sc=3072
  8. 50 pa=-1024
  9. 60 tz=239
  10. 70 tp=1319
  11. 80 gosub4530
  12. 90 dims%(30),z%(30),bz$(30),le%(30),ty$(30),ug$(30),bz%(82)
  13. 100 close2:close15
  14. 110 open15,8,15,"i0"
  15. 120 gosub150
  16. 130 goto670
  17. 140 :
  18. 150 rem *datei einlesen*
  19. 160 gosub380
  20. 170 print#15,"u1:"2;0;18;0:print#15,"b-p:"2;162:rem id
  21. 180 get#2,a$:get#2,b$:id$=a$+b$
  22. 190 ifid$<>"dd"thengosub390:return
  23. 200 rn=663:gosub410
  24. 210 gosub360:gosub350
  25. 220 input#2,ad,fz
  26. 230 mf=fz
  27. 240 fora=1tofz
  28. 250 s%(a)=0:z%(a)=1+a*2
  29. 260 input#2,bz$(a),le%(a),ty$(a)
  30. 270 next
  31. 280 rn=664:gosub410
  32. 290 gosub360:gosub350
  33. 300 fora=0to82:input#2,b$:bz%(a)=val(b$):next
  34. 310 gosub390
  35. 320 return
  36. 330 :
  37. 340 rem *b-p,u1,u2,open,close*
  38. 350 print#15,"b-p:";2;1:return
  39. 360 print#15,"u1:";2;0;rt;rs:return
  40. 370 print#15,"u2:";2;0;rt;rs:return
  41. 380 open2,8,2,"#":return
  42. 390 close2:return
  43. 400 :
  44. 410 rem *blockumrechnung*
  45. 420 ifrn<358thenaa=0:bb=22:dd=1:goto460
  46. 430 ifrn<471thenaa=357:bb=20:dd=19:goto460
  47. 440 ifrn<580thenaa=471:bb=19:dd=25:goto460
  48. 450 aa=579:bb=18:dd=31
  49. 460 rt=int(((rn-aa)-1)/(bb-1))+dd:rs=rn-aa-(rt-dd)*bb+(rt-dd-1):return
  50. 470 :
  51. 480 rem *hash-zahl*
  52. 490 hz$=ug$(1)+"aaaaaa"
  53. 500 h1=0:c=0
  54. 510 fora=1to6
  55. 520 h1=asc(mid$(hz$,a,1))
  56. 530 h1=(h1orc)-(h1andc)
  57. 540 c=((2*h1)and255)or(sgn(cand128))
  58. 550 next
  59. 560 hz=int(h1*662/255):ifhz=0thenhz=1
  60. 570 return
  61. 580 :
  62. 590 rem *maskendefinition*
  63. 600 fora=1tofz
  64. 610 s%(a)=0:z%(a)=1+a*2
  65. 620 bz$(a)=fb$(a):le%(a)=fl(a):ty$(a)=ft$(a)
  66. 630 next
  67. 640 mf=fz
  68. 650 return
  69. 660 :
  70. 670 rem *menue*
  71. 680 print"[147]"
  72. 690 gosub1830:print" [146]";
  73. 700 print"     auswahlmenue                       [146]":print
  74. 710 print"   d[146] datendiskette wechseln"
  75. 720 print"   e[146] eintragen von datensaetzen"
  76. 730 print"   s[146] suchen von datensaetzen"
  77. 740 print"   a[146] aendern von datensaetzen"
  78. 750 print"   l[146] loeschen von datensaetzen"
  79. 760 print"   b[146] blaettern in der datei"
  80. 770 print"   k[146] komplette datei ausdrucken"
  81. 780 print"   n[146] neue datei aufbauen"
  82. 790 print"   v[146] verlassen des programms"
  83. 800 print
  84. 810 gosub1830:print" [146]";
  85. 820 print"     kommando ?                         [146]";
  86. 830 fr=fre(0)
  87. 840 k$="desalbkn"
  88. 850 geta$:fora=1tolen(k$)
  89. 860 ifa$=mid$(k$,a,1)then910
  90. 870 ifa$="v"andid$="dd"thengosub4370
  91. 880 ifa$="v"thenclose15:end
  92. 890 next
  93. 900 goto850
  94. 910 ifid$<>"dd"anda$<>"n"anda$<>"d"then850
  95. 920 onagosub3310,1860,2190,3030,3110,3170,3230,3390,4370
  96. 930 goto670
  97. 940 :
  98. 950 rem *funktionstasten*
  99. 960 pokecs,0:pokecz,23:syscr
  100. 970 print"   f1 : durchfuehrung der funktion     [146]"
  101. 980 print" help : rueckkehr zum auswahlmenue     [146]";
  102. 990 return
  103. 1000 :
  104. 1010 rem *maskenaufbau/steuerung*
  105. 1020 rf=0:rem returnflag init.
  106. 1030 fora=1tomf
  107. 1040 pokecs,s%(a):pokecz,z%(a):syscr
  108. 1050 ifda=0thenprintbz$(a)"?"
  109. 1060 next
  110. 1070 zz=1
  111. 1080 :
  112. 1090 :
  113. 1100 :
  114. 1110 ifda=1thenpokecs,s%(zz)+len(bz$(zz))+1:goto1130
  115. 1120 pokecs,s%(zz)+len(bz$(zz))+2
  116. 1130 pokecz,z%(zz):syscr
  117. 1140 gosub1410:rem eingaberoutine
  118. 1150 pokea,peek(a)and127
  119. 1160 ifa$="[145]"andzz>1thenzz=zz-1:goto1080
  120. 1170 if(a$=""orasc(a$)=13)andzz<mfthenzz=zz+1:goto1080
  121. 1180 ifa$="[218]"thenrf=1:return
  122. 1190 ifa$<>"[211]"then1080
  123. 1200 :
  124. 1210 :
  125. 1220 :
  126. 1230 ifda<>1then1340
  127. 1240 da=0:fora=1tomf
  128. 1250 ug$(a)=""
  129. 1260 sp=40*z%(a)+s%(a)+len(bz$(a))+sc+1
  130. 1270 forb=sptosp+le%(a)-1
  131. 1280 pe=peek(b):ifpe<32thenpe=pe+64
  132. 1290 ug$(a)=ug$(a)+chr$(pe)
  133. 1300 nextb,a
  134. 1310 return
  135. 1320 :
  136. 1330 rem *maskenfelder einlesen*
  137. 1340 fora=1tomf
  138. 1350 ug$(a)=""
  139. 1360 pokecs,10:pokecz,z%(a):syscr
  140. 1370 poketz,1:poketp,13:inputug$(a)
  141. 1380 next
  142. 1390 return
  143. 1400 :
  144. 1410 rem *eingaberoutine*
  145. 1420 ml=0
  146. 1430 a=sc+80
  147. 1440 pokea,peek(a)and127
  148. 1450 a=sc+40*peek(cz)+peek(cs)
  149. 1460 pokea,peek(a)or128:pokea+pa,93
  150. 1470 geta$:ifa$=""then1470
  151. 1480 ifml=le%(zz)then1570
  152. 1490 ifty$(zz)="a"then1520
  153. 1500 ifty$(zz)="n"then1540
  154. 1510 ifty$(zz)="b"then1560
  155. 1520 ifasc(a$)=34ora$=":"ora$=","ora$<" "ora$>"z"then1570
  156. 1530 ml=ml+1:printa$;:goto1440
  157. 1540 ifa$>","anda$<":"ora$=" "thenml=ml+1:printa$;:goto1440
  158. 1550 goto1570
  159. 1560 ifa$="a"ora$="n"ora$=" "thenml=ml+1:printa$;:goto1440
  160. 1570 ifasc(a$)=20andda=0andml>0thenml=ml-1:printa$;:goto1440
  161. 1580 ifa$="[157]"andml>0thenml=ml-1:printa$;:goto1440
  162. 1590 ifa$=""andml<le%(zz)thenml=ml+1:printa$;:goto1440
  163. 1600 ifa$=""ora$="[145]"ora$="[218]"ora$="[211]"thenreturn
  164. 1610 goto1440
  165. 1620 :
  166. 1630 rem *infos dateiaufbau*
  167. 1640 print"feldnr    bezeichnung    laenge    typ "
  168. 1650 print"           (max.10)     (max.67)  (a/n)[146]"
  169. 1660 return
  170. 1670 :
  171. 1680 rem *infos 3*
  172. 1690 ifaf=1thenprint"     aendern von datensaetzen           [146]";:return
  173. 1700 ifbf=1thenprint"     blaettern in der datei             [146]";:return
  174. 1710 ifef=1thenprint"     eintragen von datensaetzen         [146]";:return
  175. 1720 iflf=1thenprint"     loeschen von datensaetzen          [146]";:return
  176. 1730 print"     suchen von datensaetzen            [146]";:return
  177. 1740 :
  178. 1750 rem *infos 4*
  179. 1760 pokecs,0:pokecz,23:syscr
  180. 1770 print"   dateiende erreicht                  [146]"
  181. 1780 print"   druecken sie eine taste             [146]";
  182. 1790 geta$:ifa$=""then1790
  183. 1800 return
  184. 1810 :
  185. 1820 rem *infos 2*
  186. 1830 print"                                       [146]";
  187. 1840 return
  188. 1850 :
  189. 1860 rem *eintragen*
  190. 1870 ifid$<>"dd"thenreturn:rem falsche diskette
  191. 1880 print"[147]";
  192. 1890 gosub1830:print" [146]";
  193. 1900 ef=1:rem eintr.flag setzen
  194. 1910 gosub1680
  195. 1920 ef=0:rem eintr.flag loeschen
  196. 1930 gosub950:gosub1010
  197. 1940 ifad=662orrf=1thenreturn
  198. 1950 ad=ad+1
  199. 1960 open2,8,2,"#"
  200. 1970 gosub480:rem hash-zahl
  201. 1980 rn=hz
  202. 1990 print""rn" "
  203. 2000 by=int((rn-1)/8):bi=rn-1-8*by
  204. 2010 if(bz%(by)and2^bi)<>0then2060
  205. 2020 gosub410
  206. 2030 gosub360:gosub350
  207. 2040 get#2,a$
  208. 2050 ifa$="[255]"then2090
  209. 2060 rn=rn+1:ifrn=663thenrn=1
  210. 2070 ifrn=hzthenclose2:return
  211. 2080 goto1990
  212. 2090 gosub350
  213. 2100 fora=1tofz
  214. 2110 ifug$(a)=""thenug$(a)="*"
  215. 2120 print#2,ug$(a);chr$(13);
  216. 2130 next
  217. 2140 bz%(by)=bz%(by)or2^bi
  218. 2150 gosub370:close2
  219. 2160 ifaf=1orlf=1thenreturn
  220. 2170 goto1880
  221. 2180 :
  222. 2190 rem *suchen*
  223. 2200 rf=0:rem returnflag init.
  224. 2210 hf=0:rem hilfsflag initialisieren (blockgrenze ueberschritten?)
  225. 2220 print"[147]";
  226. 2230 gosub1830:print" [146]";
  227. 2240 gosub1680
  228. 2250 ifbf=1then2280
  229. 2260 gosub950:gosub1010
  230. 2270 ifrf=1thenreturn
  231. 2280 open2,8,2,"#"
  232. 2290 gosub480:rem hash-zahl
  233. 2300 rn=hz:gosub2830:rem suchabbruch
  234. 2310 print""rn" "
  235. 2320 by=int((rn-1)/8):ifbz%(by)=0thenrn=8*(by+1)+1:goto2380
  236. 2330 bi=rn-1-8*by:if(bz%(by)and2^bi)=0then2370
  237. 2340 gosub410
  238. 2350 gosub360:gosub350
  239. 2360 get#2,a$:ifa$<>"[255]"then2420
  240. 2370 rn=rn+1
  241. 2380 ifrn>662thenrn=1:hf=1:rem hf=1:blockgrenze ueberschritten
  242. 2390 ifhf=1thenifrn>=hzthengosub1750:rf=1:close2:return
  243. 2400 geta$:ifa$=""then2310
  244. 2410 rf=1:close2:return
  245. 2420 gosub350
  246. 2430 fora=1tofz:input#2,ag$(a):ifag$(a)="*"thenag$(a)=""
  247. 2440 next
  248. 2450 ifbf=1then2500
  249. 2460 forb=1tofz
  250. 2470 ifug$(b)=""then2490
  251. 2480 ifleft$(ag$(b),len(ug$(b)))<>ug$(b)then2370
  252. 2490 next
  253. 2500 print"[147]";
  254. 2510 gosub1830:print" [146]";
  255. 2520 gosub1680
  256. 2530 forb=1tofz
  257. 2540 pokecs,0:pokecz,1+b*2:syscr
  258. 2550 printbz$(b)+": ";:printag$(b)
  259. 2560 next
  260. 2570 gosub2860:rem drucken?
  261. 2580 iflf=1thengosub2710:rem loeschflag gesetzt?
  262. 2590 iflf=1anda$="j"thenclose2:return
  263. 2600 iful=1andlf=1thenrf=1:close2:return
  264. 2610 iful=1thengosub1750:close2:return
  265. 2620 ifkf=1then2690
  266. 2630 pokecs,0:pokecz,23:syscr
  267. 2640 print"     weitersuchen (j/n) ?              [146]"
  268. 2650 gosub1830
  269. 2660 geta$:ifa$<>"j"anda$<>"n"then2660
  270. 2670 ifa$="n"and(bf=1oraf=1orlf=1orkf=1)thenclose2:return
  271. 2680 ifa$="n"thenclose2:goto2200
  272. 2690 gosub2830:goto2370
  273. 2700 :
  274. 2710 rem *sicherheitsabfrage*
  275. 2720 pokecs,0:pokecz,23:syscr
  276. 2730 print"     loeschen (j/n) ?                  [146]"
  277. 2740 gosub1830
  278. 2750 geta$:ifa$<>"j"anda$<>"n"then2750
  279. 2760 ifa$="n"thenreturn
  280. 2770 bz%(by)=bz%(by)andnot2^bi
  281. 2780 gosub350:print#2,"[255]":gosub370
  282. 2790 ad=ad-1:gf=1:rem geloeschtflag setzen
  283. 2800 return
  284. 2810 :
  285. 2820 rem *suchabbruch*
  286. 2830 pokecs,0:pokecz,23:syscr:print" abbruch der suche mit beliebiger taste[146]"
  287. 2840 gosub1830:return
  288. 2850 :
  289. 2860 rem *drucken*
  290. 2870 ifkf=1then2920
  291. 2880 pokecs,0:pokecz,23:syscr
  292. 2890 print"     ausdrucken (j/n) ?                [146]":gosub1830
  293. 2900 geta$:ifa$<>"j"anda$<>"n"then2900
  294. 2910 ifa$="n"thenreturn
  295. 2920 open4,4
  296. 2930 forb=1tofz
  297. 2940 ifag$(b)=""then2970
  298. 2950 ifkf=1thenprint#4,ag$(b)"  ";:goto2970
  299. 2960 print#4,bz$(b)+" :    "ag$(b)
  300. 2970 next
  301. 2980 ifkf=1thenprint#4
  302. 2990 print#4
  303. 3000 close4
  304. 3010 return
  305. 3020 :
  306. 3030 rem *aendern*
  307. 3040 af=1:rem aendernflag setzen
  308. 3050 gosub3110:rem loeschen
  309. 3060 ifrf=1orgf=0thenaf=0:return:rem returnflag gesetzt?
  310. 3070 print"";:gosub1890:rem eintragen
  311. 3080 af=0:rem aendernflag loeschen
  312. 3090 return
  313. 3100 :
  314. 3110 rem *loeschen*
  315. 3120 lf=1:rem loeschflag setzen
  316. 3130 gosub2190:rem suchen
  317. 3140 lf=0:rem loeschflag loeschen
  318. 3150 return
  319. 3160 :
  320. 3170 rem *blaettern*
  321. 3180 bf=1:rem blaetternflag setzen
  322. 3190 gosub2190:rem suchen
  323. 3200 bf=0:rem blaetternflag loeschen
  324. 3210 return
  325. 3220 :
  326. 3230 rem *komplette datei ausdrucken*
  327. 3240 open4,4
  328. 3250 a$="*************************************":print#4,a$
  329. 3260 print#4,"*datamaster vertrieb:baloui software*"
  330. 3270 print#4,a$
  331. 3280 fora=1to3:print#4:next:close4
  332. 3290 kf=1:gosub3170:kf=0:return
  333. 3300 :
  334. 3310 rem *datendisk wechseln*
  335. 3320 ifid$="dd"thengosub4370
  336. 3330 pokecs,0:pokecz,22:syscr
  337. 3340 print" bitte legen sie eine datendiskette ein [146]";
  338. 3350 print" und druecken sie eine beliebige taste  [146]";
  339. 3360 geta$:ifa$=""then3360
  340. 3370 gosub150:return
  341. 3380 :
  342. 3390 rem *dateiaufbau*
  343. 3400 ifid$="dd"thengosub4370
  344. 3410 print"[147]";
  345. 3420 gosub1630
  346. 3430 gosub950:rem infos funktionstasten
  347. 3440 :
  348. 3450 rem maskendefinition
  349. 3460 mf=30
  350. 3470 fora=1to10
  351. 3480 pokecs,0:pokecz,1+2*a:syscr
  352. 3490 print""a"[157] [146]"
  353. 3500 next
  354. 3510 iffz=0then3550
  355. 3520 fora=1tofz
  356. 3530 fb$(a)=bz$(a):fl(a)=le%(a):ft$(a)=ty$(a)
  357. 3540 next
  358. 3550 fora=1to30step3
  359. 3560 s%(a)=9:z%(a)=3+2*int(a/3):bz$(a)="":le%(a)=10:ty$(a)="a"
  360. 3570 s%(a+1)=24:z%(a+1)=3+2*int(a/3):bz$(a+1)="":le%(a+1)=2:ty$(a+1)="n"
  361. 3580 s%(a+2)=34:z%(a+2)=3+2*int(a/3):bz$(a+2)="":le%(a+2)=1:ty$(a+2)="b"
  362. 3590 next
  363. 3600 da=1:gosub1010:da=0:rem maskenaufbau/steuerung
  364. 3610 ifrf=1thengosub590:return
  365. 3620 ss=0:fora=1to30step3:ss=ss+val(ug$(a+1)):ifval(ug$(a+1))>67then3640
  366. 3630 next:ss=ss+10:ifss<255then3690
  367. 3640 pokecs,0:pokecz,23:syscr
  368. 3650 print" feld- bzw. satzlaenge ueberschritten![146]"
  369. 3660 print"     druecken sie eine taste          [146]";
  370. 3670 geta$:ifa$=""then3670
  371. 3680 gosub950:da=1:gosub1070:da=0:goto3610:rem einsprg.maskensteuerung
  372. 3690 fora=1to30step3
  373. 3700 ifug$(a)="          "then3760
  374. 3710 ifval(ug$(a+1))>0and(ug$(a+2)="a"orug$(a+2)="n")then3760
  375. 3720 pokecs,0:pokecz,23:syscr
  376. 3730 print"ihre dateibeschreibung ist unvollstaen-[146]"
  377. 3740 print" dig bzw. fehlerhaft. korrigieren sie! [146]";:forb=1to3000:nextb
  378. 3750 gosub950:da=1:gosub1070:da=0:goto3610
  379. 3760 nexta
  380. 3770 pokecs,0:pokecz,23:syscr
  381. 3780 print"     korrektur (j/n) ?                 [146]"
  382. 3790 gosub1830
  383. 3800 geta$:ifa$<>"j"anda$<>"n"then3800
  384. 3810 ifa$="n"then3850
  385. 3820 gosub950:rem infos dateiaufbau
  386. 3830 da=1:gosub1070:da=0:goto3610:rem einsprg.maskensteuerung
  387. 3840 ad=0:rem anz.datensaetze init.
  388. 3850 pokecs,0:pokecz,23:syscr
  389. 3860 print"  sind sie sicher, dass sie eine neue  [146]"
  390. 3870 print"     datei aufbauen wollen (j/n) ?     [146]";
  391. 3880 geta$:ifa$<>"j"anda$<>"n"then3880
  392. 3890 ifa$="n"thengosub590:return
  393. 3900 fz=10
  394. 3910 fora=1to10
  395. 3920 fb$(a)=ug$(a*3-2):rem feldbezeichnung
  396. 3930 fl(a)=val(ug$(a*3-1)):rem feldlaenge
  397. 3940 ft$(a)=ug$(a*3):rem feldtyp
  398. 3950 next
  399. 3960 fora=1to9
  400. 3970 iffb$(a)<>"          "then4030
  401. 3980 forb=ato9
  402. 3990 fb$(b)=fb$(b+1):fl(b)=fl(b+1)
  403. 4000 ft$(b)=ft$(b+1)
  404. 4010 nextb
  405. 4020 fz=fz-1
  406. 4030 nexta
  407. 4040 iffb$(10)="          "thenfz=fz-1
  408. 4050 fora=1tofz
  409. 4060 s%(a)=0:z%(a)=1+a*2:bz$(a)=fb$(a):le%(a)=fl(a):ty$(a)=ft$(a)
  410. 4070 next
  411. 4080 fora=0to82:bz%(a)=0:next
  412. 4090 ad=0:rem anz.datensaetze init.
  413. 4100 pokecs,0:pokecz,23:syscr
  414. 4110 print"bitte legen sie eine leere diskette ein[146]"
  415. 4120 print"     und druecken sie eine taste       [146]";
  416. 4130 geta$:ifa$=""then4130
  417. 4140 gosub380:print#15,"u1:"2;0;18;0:print#15,"b-p:"2;162
  418. 4150 a$="":b$="":get#2,a$:get#2,b$:a$=a$+b$
  419. 4160 gosub390
  420. 4170 ifa$="dd"then4100
  421. 4180 pokecs,0:pokecz,23:syscr
  422. 4190 print"  bitte haben sie geduld. der aufbau   [146]"
  423. 4200 print"  der datei benoetigt mehrere minuten  [146]";
  424. 4210 print#15,"n:datamaster-datei,dd"
  425. 4220 gosub380:print#15,"u1:"2;0;18;0
  426. 4230 id$="dd":print#15,"b-p:"2;162:print#2,id$;:print#15,"u2:"2;0;18;0
  427. 4240 print"blocknr.[146]"
  428. 4250 forrn=1to662
  429. 4260 print""rn"  [146]"
  430. 4270 gosub410
  431. 4280 gosub350
  432. 4290 print#2,"[255]"
  433. 4300 gosub370
  434. 4310 nextrn
  435. 4320 gosub390
  436. 4330 gosub4370:rem maske abspeichern
  437. 4340 gosub150:rem daten einlesen
  438. 4350 return
  439. 4360 :
  440. 4370 rem *verlassen*
  441. 4380 gosub380
  442. 4390 rn=663
  443. 4400 gosub410
  444. 4410 gosub350
  445. 4420 print#2,ad;chr$(13);fz
  446. 4430 fora=1tofz
  447. 4440 print#2,bz$(a);chr$(13);le%(a);chr$(13);ty$(a)
  448. 4450 next
  449. 4460 gosub370
  450. 4470 rn=664:gosub410:gosub350
  451. 4480 fora=0to82:print#2,str$(bz%(a)):next
  452. 4490 gosub370:gosub390
  453. 4500 return
  454. 4510 :
  455. 4520 rem *titelbild*
  456. 4530 :
  457. 4540 print"[147]"
  458. 4550 print"              datamaster"
  459. 4560 print"              ----------"
  460. 4570 print"       (c) baloui software, 1985"
  461. 4730 return
  462.