home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 9 / 64er_Magazin_Sonderheft_09_86-09_1986_Markt__Technik_de_Side_B.d64 / dita.bas (.txt) next >
Encoding:
Commodore BASIC  |  1986-01-01  |  12.4 KB  |  506 lines
  1. 10 rem ********************************
  2. 20 rem *                              *
  3. 30 rem *   s.linke  &  j.pleschka     *
  4. 40 rem *                              *
  5. 50 rem ********************************
  6. 60 rem
  7. 70 rem
  8. 80 rem dita kors: 1 20.5.86
  9. 90 az = 100 * 3 :rem fuer etiketten
  10. 100 dim et$(300)
  11. 110 af = 32 :rem anzahl files auf tasche
  12. 120 dim sa$(32),sb$(32) :rem files seite a / seite b
  13. 130 for i=1toaz:et$(i)="*":next
  14. 140 ae = 1 :rem anzahl etiketten
  15. 150 et$(0) = "   (c) s.linke & j.pleschka   "
  16. 160 et$(1) = " tel.:07533 / 2087     "
  17. 170 et$(2) = " tel.:07533 / 3128     "
  18. 180 poke53280,0:poke53281,0:poke646,1
  19. 190 printchr$(142) :rem gross/grafik
  20. 200 poke788,52  :rem stoptaste sperren
  21. 210 printchr$(8) :rem shift/commodore sperren
  22. 220 rem --------------------
  23. 230 rem char-code fuer etikett auf vdu
  24. 240 lo = 207:ro = 208
  25. 250 lu = 204:ru = 186
  26. 260 lb = 180:rb = 170
  27. 270 ob = 183:ub = 175
  28. 280 si =  18:so = 146
  29. 290 rem --------------------
  30. 300 lg = 30
  31. 310 na$ = "disk.etiketten"
  32. 320 le$ = "    "
  33. 330 f1 = 153 :rem hellgruen
  34. 340 f2 =  28 :rem rot
  35. 350 f3 = 158 :rem gelb
  36. 360 dim c1(4),c2(4)     :rem farben
  37. 370 dim m$(24)
  38. 380 rem --------------------
  39. 390 rem menue-zeilen
  40. 400 m$(1)  = "erfassen "
  41. 410 m$(2)  = "druck    "
  42. 420 m$(3)  = "etiketten"
  43. 430 m$(4)  = "korrektur"
  44. 440 rem --------------------
  45. 450 m$(5)  = "seite a  "
  46. 460 m$(6)  = "seite b  "
  47. 470 m$(7)  = "druck    "
  48. 480 m$(8)  = "fertig   "
  49. 490 rem --------------------
  50. 500 m$(9)  = "tasche   "
  51. 510 m$(10) = "etiketten"
  52. 520 m$(11) = "fertig   "
  53. 530 m$(12) = "         "
  54. 540 rem --------------------
  55. 550 m$(13) = "sichern  "
  56. 560 m$(14) = "laden    "
  57. 570 m$(15) = "fertig   "
  58. 580 m$(16) = "         "
  59. 590 rem --------------------
  60. 600 m$(17) = "kennung  "
  61. 610 m$(18) = "fertig   "
  62. 620 m$(19) = "         "
  63. 630 m$(20) = "         "
  64. 640 rem --------------------
  65. 650 m$(21) = "vorlegen "
  66. 660 m$(22) = "druck    "
  67. 670 m$(23) = "fertig   "
  68. 680 m$(24) = "         "
  69. 690 rem --------------------
  70. 700 rem diverse  strings fuer druck
  71. 710 hd$ = ""
  72. 720 ri$ = ""
  73. 730 ke$ = " kennung (maximal 30 zeichen) "
  74. 740 z1$ = ke$
  75. 750 t1$ = "                "
  76. 760 t2$ = "                              "
  77. 770 d1$ = "*  "
  78. 780 d2$ = "  *"
  79. 790 d3$ = "************************************"
  80. 800 d4$ = "+......+"
  81. 810 d6$ = "........................................................"
  82. 820 dm$ = "                                                        "
  83. 830 dx$ = "--------------------------------------------------------"
  84. 840 d7$ = "      "
  85. 850 d8$ = "                         "
  86. 860 dim pe(10)
  87. 870 pe$(0) = " "
  88. 880 pe$(1) = ".      .          "
  89. 890 pe$(2) = "          .      ."
  90. 900 pe$(3) = ".      ."
  91. 910 pe$(4) = "       ."
  92. 920 pe$(5) = ".       "
  93. 930 dl$ = "                              "
  94. 940 goto 1580 :rem ins hauptprogramm
  95. 950 rem ------------------------------
  96. 960 rem drucker anmelden
  97. 970 open 3,4
  98. 980 return
  99. 990 rem ------------------------------
  100. 1000 rem zeichen z der laenge lg ausgeben
  101. 1010 fori=1tolg:printchr$(z);:next
  102. 1020 return
  103. 1030 rem ------------------------------
  104. 1040 rem rahmen ausgeben
  105. 1050 printchr$(147); :rem clr/home
  106. 1060 print"";
  107. 1070 z=ob:printle$;chr$(lo);:gosub 1010:printchr$(ro)
  108. 1080 z=32:printle$;chr$(lb);:gosub 1010:printchr$(rb)
  109. 1090 z=ub:printle$;chr$(lu);:gosub 1010:printchr$(ru)
  110. 1100 z=32
  111. 1110 for j=1to4
  112. 1120 printle$;chr$(lb);:gosub 1010:printchr$(rb)
  113. 1130 next
  114. 1140 z=ub:printle$;chr$(lu);:gosub 1010:printchr$(ru)
  115. 1150 return
  116. 1160 rem ------------------------------
  117. 1170 rem menuezeilen ausgeben
  118. 1180 printchr$(19);
  119. 1190 printchr$(si);chr$(c1(1));m$(1);chr$(so);chr$(32);
  120. 1200 printchr$(si);chr$(c1(2));m$(2);chr$(so);chr$(32);
  121. 1210 printchr$(si);chr$(c1(3));m$(3);chr$(so);chr$(32);
  122. 1220 printchr$(si);chr$(c1(4));m$(4);chr$(so);chr$(32)
  123. 1230 p = m0*4
  124. 1240 rem ------------------------------
  125. 1250 print hd$;
  126. 1260 printchr$(si);chr$(c2(1));m$(p+1);chr$(so);chr$(32);
  127. 1270 printchr$(si);chr$(c2(2));m$(p+2);chr$(so);chr$(32);
  128. 1280 printchr$(si);chr$(c2(3));m$(p+3);chr$(so);chr$(32);
  129. 1290 printchr$(si);chr$(c2(4));m$(p+4);chr$(so);chr$(32);
  130. 1300 if z1$ = "*"thenz1$=      dl$
  131. 1310 print left$(hd$,6);ri$;chr$(f3);chr$(si);z1$;chr$(so);
  132. 1320 print left$(hd$,9);ri$;
  133. 1330 if z2$ = "*"thenz2$=left$(dl$,23)
  134. 1340 if z3$ = "*"thenz3$=left$(dl$,23)
  135. 1350 printchr$(si);chr$(f3);"a:";chr$(so);chr$(f1);"  ";z2$
  136. 1360 print"";ri$;
  137. 1370 printchr$(si);chr$(f3);"b:";chr$(so);chr$(f1);"  ";z3$
  138. 1380 return
  139. 1390 rem ------------------------------
  140. 1400 rem highlight loeschen
  141. 1410 for i=1to4:c1(i)=f2:c2(i)=f2:next
  142. 1420 gosub1180
  143. 1430 return
  144. 1440 rem ------------------------------
  145. 1450 rem auf zeichen von tastatur warten
  146. 1460 poke 198,0
  147. 1470 getx$:ifx$="" then 1470
  148. 1480 z=asc(x$)
  149. 1490 return
  150. 1500 rem ------------------------------
  151. 1510 rem abbruch nach diskerror
  152. 1520 close2:close15
  153. 1530 for i=1to5000:next
  154. 1540 print left$(hd$,3);t2$;
  155. 1550 goto1610
  156. 1560 rem ------------------------------
  157. 1570 rem menuesteuerung
  158. 1580 fa=664:fb=664
  159. 1590 z2$="*":z3$="*"
  160. 1600 printchr$(f1);:gosub 1050
  161. 1610 m = 1:mm=1:m0=1:m1 = 0 :rem norm menuesteuerung
  162. 1620 for i=1to4:c1(i)=f2:c2(i)=f2:next
  163. 1630 c1(m0) = f3
  164. 1640 c2(m1) = f3
  165. 1650 gosub 1180 :rem menuezeilen ausgeben
  166. 1660 gosub 1460 :rem zeichen von tastatur
  167. 1670 rem wenn f8 dann stop und shift/commodore zulassen und schluss
  168. 1680 if z=140  then poke788,49:printchr$(9):end
  169. 1690 if z=13  then 1800
  170. 1700 if z=19  then 1610
  171. 1710 if z<>32 then 1660
  172. 1720 mm=mm+1
  173. 1730 if m  > 2 then m  = 1
  174. 1740 if mm > 4 then mm = 1
  175. 1750 if m=1 then m0=mm:goto1620
  176. 1760 m1=mm
  177. 1770 if m$((m0*4)+m1) = "         " then  m1=1:mm=1
  178. 1780 goto  1620
  179. 1790 rem ------------------------------
  180. 1800 gosub 1410 :rem highlight loeschen
  181. 1810 if m = 1 then m=2:m1=1:mm=1:goto1750
  182. 1820 if (m0=1) then 2400 :rem erfassen
  183. 1830 if (m0=2) then 3760 :rem druck
  184. 1840 if (m0=3) then 4580 :rem etiketten
  185. 1850 if (m0=4) then 1880 :rem korrektur
  186. 1860 rem ------------------------------
  187. 1870 rem **** korrektur *****
  188. 1880 if m1=2then 1610 :rem fertig
  189. 1890 k$ = "":zz=0
  190. 1900 print left$(hd$,6);">";
  191. 1910 gosub 1460 :rem zeichen von tastatur
  192. 1920 if z=13 then print left$(hd$,6);" ";:mm=mm+1:goto1730
  193. 1930 if z=19 then zz=0:k$="":goto 1990 :rem clr
  194. 1940 if z<>20 then gosub 2190:goto 1980
  195. 1950 if zz<=1 then zz=0:k$="":goto 1990
  196. 1960 zz=zz-1:k$=left$(k$,zz) :goto 1990
  197. 1970 if zz=30 then 2010
  198. 1980 k$ = k$+x$:zz=zz+1
  199. 1990 ke$=left$(k$+t2$,30)
  200. 2000 et$((ae*3)   ) = ke$
  201. 2010 z1$ = ke$
  202. 2020 gosub 1310
  203. 2030 goto  1910
  204. 2040 rem ------------------------------
  205. 2050 rem initialisierung disk
  206. 2060 open15,8,15,"i0"
  207. 2070 rem fehlerabfrage disk
  208. 2080 input#15,a$,b$,c$,d$
  209. 2090 if a$="00" then return
  210. 2100 printleft$(hd$,3);t2$;
  211. 2110 print left$(hd$,3);a$;",";b$;",";c$;",";d$
  212. 2120 return
  213. 2130 rem ------------------------------
  214. 2140 rem zeichen von disk kolen
  215. 2150 rem auf druckbarkeit pruefen
  216. 2160 rem *****************************
  217. 2170 get#2,x$:if x$="" then x$=chr$(0)
  218. 2180 z=asc(x$)
  219. 2190 if z =160 then x$=".":return
  220. 2200 if z < 32 or z > 127 then x$="?" :rem unzul.zeichen
  221. 2210 return
  222. 2220 rem ------------------------------
  223. 2230 rem startadresse ermitteln
  224. 2240 aa$ = "      "
  225. 2250 if ft <> 2 then return :rem nicht prg-file
  226. 2260 if sp=0 and se=0 then return
  227. 2270 open 3,8,3,"#"
  228. 2280 print#15,"b-r";3;0;sp;se
  229. 2290 gosub 2080 :rem diskerror  abfragen
  230. 2300 if a$<>"00" then 2370
  231. 2310 print#15,"b-p";3;2
  232. 2320 get#3,x$:ifx$=""thenx$=chr$(0)
  233. 2330 al=asc(x$)
  234. 2340 get#3,x$:ifx$=""thenx$=chr$(0)
  235. 2350 ah=asc(x$)*256
  236. 2360 aa=al+ah:aa$=right$("      "+str$(aa),6)
  237. 2370 close3:return
  238. 2380 rem ------------------------------
  239. 2390 rem erfassen
  240. 2400 if m1=4 then ae=ae+1:sa=0:sb=0:goto1580 :rem fertig
  241. 2410 if m1=3 then m=2:m0=2:m1=1:mm=1:goto 1620
  242. 2420 gosub2060
  243. 2430 if a$ <> "00" then 1520
  244. 2440 open2,8,2,"#"  :rem datenkanal
  245. 2450 print#15,"b-r";2;0;18;0
  246. 2460 print#15,"b-p";2;144
  247. 2470 dn$=""
  248. 2480 fori=1to16:gosub 2170:dn$=dn$+x$:next
  249. 2490 get#2,x$:get#2,x$
  250. 2500 id$ =""
  251. 2510 gosub 2170:id$=id$+x$
  252. 2520 gosub 2170:id$=id$+x$
  253. 2530 xx$=dn$+" id= "+id$
  254. 2540 et$((ae*3)+m1) = xx$
  255. 2550 et$(ae*3) = z1$
  256. 2560 z2$=et$((ae*3)+1):z3$=et$((ae*3)+2):gosub 1310
  257. 2570 print left$(hd$,14);
  258. 2580 fori=1to8
  259. 2590 printt2$;
  260. 2600 printleft$(t2$,6)
  261. 2610 next
  262. 2620 print left$(hd$,13)
  263. 2630 printchr$(si);
  264. 2640 if m1=1then print "a:";
  265. 2650 if m1=2then print "b:";
  266. 2660 printchr$(so);"  ";
  267. 2670 t=18:s=1
  268. 2680 y2=0 :rem zaehler der files
  269. 2690 y3=14:rem fuer fileuebernahme
  270. 2700 y4=0 :rem fuer anfrage
  271. 2710 if m1=1 then sa=0:fori=0toaf:sa$(i)= "*":next
  272. 2720 if m1=2 then sb=0:fori=0toaf:sb$(i)= "*":next
  273. 2730 printleft$(hd$,22);chr$(si);"return";chr$(so);" = uebernehmen ";
  274. 2740 print chr$(si);"space";chr$(so);" = ignorieren"
  275. 2750 rem ------------------------------
  276. 2760 rem freie bloecke ermitteln
  277. 2770 bf = 0
  278. 2780 for i=4to140step4
  279. 2790 if i=72 then 2830 :rem spur 18
  280. 2800 print#15,"b-p";2;i
  281. 2810 get#2,x$:ifx$=""then x$=chr$(0)
  282. 2820 bf = asc(x$)+bf
  283. 2830 next
  284. 2840 if m1=1 then fa=bf
  285. 2850 if m1=2 then fb=bf
  286. 2860 rem ------------------------------
  287. 2870 print#15,"u1";2;0;t;s
  288. 2880 gosub2080:rem diskfehler abfragen
  289. 2890 if a$ <> "00" then 1520
  290. 2900 print#15,"b-p";2;0
  291. 2910 get#2,x$:ifx$=""thenx$=chr$(0)
  292. 2920 t=asc(x$)
  293. 2930 get#2,x$:ifx$=""thenx$=chr$(0)
  294. 2940 s=asc(x$)
  295. 2950 rem schleife fuer 8 files anfang
  296. 2960 for x=0to7
  297. 2970 if y2>af-1 then 3500 :rem zuviele files
  298. 2980 print#15,"b-p";2;x*32+2
  299. 2990 get#2,x$:ifx$=""thenx$=chr$(0):rem filetyp
  300. 3000 ty = asc(x$)
  301. 3010 get#2,x$:ifx$=""thenx$=chr$(0):rem spur
  302. 3020 sp = asc(x$)
  303. 3030 get#2,x$:ifx$=""thenx$=chr$(0):rem sektor
  304. 3040 se = asc(x$)
  305. 3050 print#15,"b-p";2;x*32+30
  306. 3060 get#2,x$:ifx$=""thenx$=chr$(0):rem filetyp
  307. 3070 nb = asc(x$)
  308. 3080 get#2,x$:ifx$=""thenx$=chr$(0):rem filetyp
  309. 3090 hb = asc(x$)*256
  310. 3100 bl=hb+nb
  311. 3110 ft = ty  and 15     :rem filetyp
  312. 3120 if ft = 0 then 3500 :rem del-file nicht ausgeben
  313. 3130 print#15,"b-p";2;x*32+5
  314. 3140 ff$=""
  315. 3150 for ii=1to16
  316. 3160 gosub 2170 :rem filename holen
  317. 3170 ff$=ff$+x$
  318. 3180 next ii
  319. 3190 ff$=ff$+" "
  320. 3200 if ft=1 then ft$="seq"
  321. 3210 if ft=2 then ft$="prg"
  322. 3220 if ft=3 then ft$="usr"
  323. 3230 if ft=4 then ft$="rel"
  324. 3240 if ft>4 then ft$="???"
  325. 3250 k$  = ">"
  326. 3260 if ty and  64 then 3300
  327. 3270 k$  = " "
  328. 3280 if ty and 128 then 3300
  329. 3290 k$  = "*"
  330. 3300 ft$= k$+ft$
  331. 3310 bl$=right$("   "+str$(bl),3)
  332. 3320 bl$=bl$+"  "
  333. 3330 gosub 2240 :rem startadresse ermitteln
  334. 3340 xx$=bl$+ff$+ft$+aa$
  335. 3350 if y4 then 3440
  336. 3360 printleft$(hd$,y3);left$(ri$,4);
  337. 3370 printchr$(si);xx$;chr$(so);
  338. 3380 gosub 1460 :rem zeichen von tastatur
  339. 3390 if z=136 then y4=1:goto 3410
  340. 3400 if z<>32 and z<>13 then 3380
  341. 3410 printleft$(hd$,y3);left$(ri$,4);
  342. 3420 print t2$;"  "
  343. 3430 if z=32 then 3500 :rem ignorieren
  344. 3440 printleft$(hd$,y3);left$(ri$,4);
  345. 3450 print xx$
  346. 3460 if m1=1 then sa$(sa)=xx$:sa=sa+1
  347. 3470 if m1=2 then sb$(sb)=xx$:sb=sb+1
  348. 3480 y2=y2+1:y3=y3+1
  349. 3490 if y3 >= 22then y3=14
  350. 3500 nextx
  351. 3510 rem schleife fuer 8 files (ende)
  352. 3520 if y2>af-1 then t=0:rem das sind genug
  353. 3530 if t<>0 then goto 2870
  354. 3540 close2
  355. 3550 close15
  356. 3560 mm=mm+1:goto1740
  357. 3570 rem ------------------------------
  358. 3580 rem leerzeile ausgeben
  359. 3590 print#3,pe$(pa);d1$;dl$;d2$;pe$(pe)
  360. 3600 return
  361. 3610 rem ------------------------------
  362. 3620 rem etikett ausgeben
  363. 3630 print#3,pe$(pa);d3$;pe$(pe)
  364. 3640 if z1$ = "*" then gosub 3590:goto 3660
  365. 3650 print#3,pe$(pa);d1$;z1$;d2$;pe$(pe)
  366. 3660 print#3,pe$(pa);d3$;pe$(pe)
  367. 3670 print#3,pe$(pa);d1$;dl$;d2$;pe$(pe)
  368. 3680 if z2$ = "*" then gosub 3590:goto 3700
  369. 3690 print#3,pe$(pa);d1$;" a: ";z2$;"   ";d2$;pe$(pe)
  370. 3700 if z3$ = "*" then gosub 3590:goto 3720
  371. 3710 print#3,pe$(pa);d1$;" b: ";z3$;"   ";d2$;pe$(pe)
  372. 3720 print#3,pe$(pa);d1$;dl$;d2$;pe$(pe)
  373. 3730 print#3,pe$(pa);d3$;pe$(pe)
  374. 3740 return
  375. 3750 rem ------------------------------
  376. 3760 if m1 = 3 then sa=0:sb=0:ae=ae+1:goto 1580 :rem fertig
  377. 3770 rem druck
  378. 3780 if m1 = 1 then 4320 :rem taschen
  379. 3790 rem etiketten vorlegen/drucken
  380. 3800 pp = 0:rem anfang etiketten
  381. 3810 gosub 970 :rem drucker anmelden
  382. 3820 p=20 :rem steuerung menue
  383. 3830 m1=1
  384. 3840 for i=1to4:c2(i)=f2:next
  385. 3850 c2(m1) = f3
  386. 3860 gosub 1250 :rem menuezeile ausgeben
  387. 3870 gosub 1460 :rem zeichen von tastatur
  388. 3880 if z=13 then 3930
  389. 3890 if z<>32 then 3870
  390. 3900 m1=m1+1
  391. 3910 if m1>3 then m1=1
  392. 3920 goto 3840
  393. 3930 if m1=3 then close3:goto1580
  394. 3940 if m1=2 then pa=0:pe=0:gosub3630:print#3:m1=1:goto 3840
  395. 3950 pp = pp+1
  396. 3960 z1$ = et$((pp*3)-3)
  397. 3970 z2$ = et$((pp*3)-2)
  398. 3980 z3$ = et$((pp*3)-1)
  399. 3990 gosub 1310
  400. 4000 m1=m1+1
  401. 4010 goto 3840
  402. 4020 rem ------------------------------
  403. 4030 rem leerzeile tasche
  404. 4040 print#3,pe$(pa);dm$;pe$(pe)
  405. 4050 zz=zz+1
  406. 4060 return
  407. 4070 rem ------------------------------
  408. 4080 rem trenner tasche vorn/hinten
  409. 4090 gosub 4040:gosub 4040
  410. 4100 print#3,d4$;dx$;d4$
  411. 4110 pa=4:pe=5
  412. 4120 gosub 4040:gosub 4040
  413. 4130 return
  414. 4140 rem ------------------------------
  415. 4150 rem zeile fuer tasche seite a
  416. 4160 if zz = 10  then gosub 4090
  417. 4170 if sa$(i) = "*" then sa$(i) = d8$
  418. 4180 if ww=0 then ww=1:xx$=mid$(sa$(i),6,19)+right$(sa$(i),6):return
  419. 4190 xx$=xx$+"  "+mid$(sa$(i),6,19)+right$(sa$(i),6)
  420. 4200 print#3,pe$(pa);"  ";xx$;"  ";pe$(pe)
  421. 4210 zz=zz+1:ww=0
  422. 4220 return
  423. 4230 rem ------------------------------
  424. 4240 rem zeile fuer tasche seite b
  425. 4250 if zz = 10  then gosub 4090
  426. 4260 if sb$(i) = "*" then sb$(i) = d8$
  427. 4270 if ww=0 then ww=1:xx$=mid$(sb$(i),6,19)+right$(sb$(i),6):return
  428. 4280 xx$=xx$+"  "+mid$(sb$(i),6,19)+right$(sb$(i),6)
  429. 4290 goto4200
  430. 4300 rem ------------------------------
  431. 4310 rem tasche drucken
  432. 4320 gosub 970 :rem drucker anmelden
  433. 4330 pa=3:pe=3
  434. 4340 print#3,d4$;d6$;d4$
  435. 4350 gosub 4040
  436. 4360 pa=1:pe=2 :rem fuer etikett
  437. 4370 gosub 3630
  438. 4380 pa=3:pe=3
  439. 4390 gosub 4040
  440. 4400 zz =  0
  441. 4410 ifsa=0 then fori=0toaf:sa$(i)="*":next
  442. 4420 ifsb=0 then fori=0toaf:sb$(i)="*":next
  443. 4430 xx$=right$("    "+str$(fa),3)
  444. 4440 print#3,pe$(pa);" a=  ";xx$;" bloecke frei    ";d8$;d7$;pe$(pe)
  445. 4450 ww=0
  446. 4460 for i=0toaf-1:gosub4160:next
  447. 4470 xx$=right$("    "+str$(fb),3)
  448. 4480 gosub 4040
  449. 4490 print#3,pe$(pa);" b=  ";xx$;" bloecke frei    ";d8$;d7$;pe$(pe)
  450. 4500 ww=0
  451. 4510 for i=0toaf-1:gosub4250:next
  452. 4520 gosub 4040:gosub 4040
  453. 4530 print#3,pe$(pa);d6$;pe$(pe)
  454. 4540 fori=1to18:print#3:next :rem neue seite
  455. 4550 close3:mm=mm+2:goto1730
  456. 4560 rem ------------------------------
  457. 4570 rem etiketten laden
  458. 4580 if m1=3 then 1610 :rem fertig
  459. 4590 gosub 2060 :rem disk initialisieren
  460. 4600 if a$ <> "00" then 1520 :rem disk-error
  461. 4610 if m1=1 then 4840 :rem sichern
  462. 4620 open2,8,2,na$+",s,r"
  463. 4630 gosub 2080
  464. 4640 if a$ <> "00" then 1520 :rem file nicht da
  465. 4650 ae=0
  466. 4660 gosub 4780
  467. 4670 et$(ae*3) = xx$
  468. 4680 gosub 4780
  469. 4690 et$((ae*3)+1) = xx$
  470. 4700 gosub 4780
  471. 4710 et$((ae*3)+2) = xx$
  472. 4720 if st = 64 then 4750
  473. 4730 if et$(ae*3) = "*" then 4750
  474. 4740 ae=ae+1:goto 4660
  475. 4750 close2:close15
  476. 4760 mm=3:goto 1740
  477. 4770 rem ------------------------------
  478. 4780 xx$=""
  479. 4790 get#2,x$
  480. 4800 if asc(x$) = 13 then return
  481. 4810 xx$=xx$+x$:goto 4790
  482. 4820 rem ------------------------------
  483. 4830 rem etiketten sichern
  484. 4840 open2,8,2,na$+",s,w"
  485. 4850 gosub 2080
  486. 4860 if a$  = "00" then 4900 :rem ok
  487. 4870 close2
  488. 4880 print#15,"s:"+na$       :rem file-loeschen
  489. 4890 goto 4840
  490. 4900 for i=0toae+1
  491. 4910 xx$=et$(3*i)
  492. 4920 gosub 5020
  493. 4930 xx$=et$((3*i)+1)
  494. 4940 gosub 5020
  495. 4950 xx$=et$((3*i)+2)
  496. 4960 gosub 5020
  497. 4970 next
  498. 4980 close2:close15
  499. 4990 print"";t2$;
  500. 5000 mm=3:goto 1740
  501. 5010 rem ------------------------------
  502. 5020 for j=1tolen(xx$):x$=mid$(xx$,j,1):print#2,x$;:next
  503. 5030 print#2,chr$(13);
  504. 5040 return
  505. 5050 rem ------------------------------
  506.