home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 April / IMM0495.ISO / share / office / winlohn / winldta.bas < prev    next >
BASIC Source File  |  1994-10-10  |  5KB  |  122 lines
  1. 10 REM
  2. 20 REM
  3. 30 REM  erstellen dtaus-datei aus ascii-datei
  4. 40 REM  (c) 1994 klaus gotthardt
  5. 50 REM
  6. 60 OPEN "dtaus.txt" FOR INPUT AS #1
  7. 70 INPUT #1, ASATZART$, AKTO$, ANAME$, ABLZ$, AVERWZW$
  8. 80 REM
  9. 90 REM satzart a
  10. 100 REM
  11. 110 IF ASATZART$ <> "A" THEN PRINT "satzart a nicht vorhanden": GOTO 1190
  12. 120 OPEN "dtaus1" FOR RANDOM AS #2 LEN = 128
  13. 130 REM zum leeren
  14. 140 FIELD #2, 128 AS a0$
  15. 150 REM ---------------------- satzart a
  16. 160 FIELD #2, 7 AS A1BISA3$, 8 AS A4$, 8 AS A5$, 27 AS A6$, 6 AS A7$, 4 AS A8$, 10 AS A9$, 10 AS A10$, 48 AS A11$
  17. 170 REM ---------------------- satzart c teil 1
  18. 180 FIELD #2, 5 AS C1C2$, 8 AS C3$, 8 AS C4$, 10 AS C5$, 19 AS C6C8$, 11 AS C9$, 8 AS C10$, 10 AS C11$, 14 AS C12C13$, 27 AS C14A$, 8 AS C14B$
  19. 190 REM ---------------------- satzart c teil 2
  20. 200 FIELD #2, 27 AS C15$, 27 AS C16$, 5 AS C17C18$
  21. 210 REM ---------------------- satzart e
  22. 220 FIELD #2, 10 AS E1E3$, 7 AS E4$, 13 AS E5$, 17 AS E6$, 17 AS E7$, 13 AS E8$, 51 AS E9$
  23. 230 REM ----------------------------------- satzlaenge satzart kennzeichen
  24. 240 LSET a0$ = BLANKS$
  25. 250 LSET A1BISA3$ = "0128AGK"
  26. 260 REM ----------------------------------- absender blz
  27. 270 LSET A4$ = STRING$(8 - LEN(ABLZ$), "0") + ABLZ$
  28. 280 ABSBLZ$ = A4$
  29. 290 LSET A5$ = STRING$(8, "0")
  30. 300 REM ----------------------------------- absender name
  31. 310 LSET A6$ = ANAME$
  32. 320 ABSNAME$ = ANAME$
  33. 330 REM ---------------------------------- datum
  34. 340 LSET A7$ = MID$(DATE$, 4, 2) + MID$(DATE$, 1, 2) + MID$(DATE$, 9, 2)
  35. 350 REM ----------------------------------- absender konto
  36. 370 LSET A9$ = STRING$(10 - LEN(AKTO$), "0") + AKTO$
  37. 375 LSET A10$ = "0000000000"
  38. 377 ABSKTO$ = A9$
  39. 380 VERWZW$ = AVERWZW$
  40. 390 REM ---------------------------- satzart a schreiben
  41. 400 GOSUB 1070
  42. 410 REM
  43. 420 REM ---------------------------- satzart c
  44. 430 REM
  45. 440 INPUT #1, FELD1$, FELD2$, FELD3$, FELD4$, FELD5$
  46. 450 IF FELD1$ = "E" GOTO 870
  47. 460 IF FELD1$ <> "C" THEN PRINT "fehler, keine satzart c": GOTO 1190
  48. 470 REM ----------------------------- laenge satzart
  49. 480 LSET a0$ = BLANKS$
  50. 490 LSET C1C2$ = "0187C"
  51. 500 REM  ---------------------------- abs-blz
  52. 510 LSET C3$ = ABSBLZ$
  53. 520 REM  ---------------------------- empf-blz
  54. 530 LSET C4$ = STRING$(8 - LEN(FELD2$), "0") + FELD2$
  55. 540 REM ----------------------------- empf-kto
  56. 550 LSET C5$ = STRING$(10 - LEN(FELD3$), "0") + FELD3$
  57. 560 REM ------------------------------ 13-nullen, textschluessel, blank
  58. 570 LSET C6C8$ = "000000000000051000 "
  59. 580 REM ----------------------------- empf-betrag
  60. 590 B = INSTR(FELD5$, ",")
  61. 600 IF B > 0 THEN MID$(FELD5$, B, 1) = "."
  62. 610 STR1$ = STR$(VAL(FELD5$) * 100)
  63. 620 MID$(STR1$, 1, 1) = "0"
  64. 630 LSET C9$ = STRING$(11 - LEN(STR1$), "0") + STR1$
  65. 640 REM ----------------------------- abs-blz
  66. 650 LSET C10$ = ABSBLZ$
  67. 660 REM ----------------------------- abs-kto
  68. 670 LSET C11$ = ABSKTO$
  69. 680 REM ----------------------------- 11 nullen 3 blanks
  70. 690 LSET C12C13$ = "00000000000   "
  71. 700 REM ----------------------------- name
  72. 710 LSET C14A$ = FELD4$
  73. 720 REM ----------------------------- 8 blanks
  74. 730 LSET C14B$ = "        "
  75. 740 REM ----------------------------- satzart c teil1 schreiben
  76. 750 GOSUB 1070
  77. 760 LSET a0$ = BLANKS$
  78. 770 REM ----------------------------- abs-name
  79. 780 LSET C15$ = ABSNAME$
  80. 790 REM ----------------------------- verwendungszweck
  81. 800 LSET C16$ = VERWZW$
  82. 810 REM ----------------------------- 3 blanks keine erw.-teile
  83. 820 LSET C17C18$ = "   00"
  84. 830 REM ------------------------------- satzart c teil2 schreiben
  85. 840 GOSUB 1070
  86. 850 REM
  87. 860 GOTO 440
  88. 870 REM ------------------------------------------------ satzart e
  89. 880 LSET a0$ = BLANKS$
  90. 890 LSET E1E3$ = "0128E     "
  91. 900 REM ------------------------------- anzahl saetze c
  92. 910 LSET E4$ = STRING$(7 - LEN(FELD2$), "0") + FELD2$
  93. 920 REM ------------------------------- summe betraege
  94. 930 B = INSTR(FELD3$, ",")
  95. 940 IF B > 0 THEN MID$(FELD3$, B, 1) = "."
  96. 950 STR1$ = STR$(VAL(FELD3$) * 100)
  97. 960 MID$(STR1$, 1, 1) = "0"
  98. 970 LSET E5$ = STRING$(13 - LEN(STR1$), "0") + STR1$
  99. 980 REM ------------------------------- summe kontonummern
  100. 990 LSET E6$ = STRING$(17 - LEN(FELD4$), "0") + FELD4$
  101. 1000 REM ------------------------------- summe bankleitzahlen
  102. 1010 LSET E7$ = STRING$(17 - LEN(FELD5$), "0") + FELD5$
  103. 1020 LSET E8$ = "0000000000000"
  104. 1030 REM -------------------------------------- satz schreiben
  105. 1040 GOSUB 1070
  106. 1050 GOTO 1190
  107. 1060 REM ------------------------------------ unterprogramme
  108. 1070 REM ------------------------------ umsetzung gross, satz ausgeben
  109. 1080 FOR I = 1 TO 128
  110. 1090 ZWASC$ = MID$(a0$, I, 1)
  111. 1100 IF ZWASC$ >= "a" AND ZWASC$ <= "z" THEN ZWASC$ = CHR$(ASC(ZWASC$) - 32)
  112. 1110 IF ZWASC$ = "ä" THEN ZWASC$ = "Ä"
  113. 1120 IF ZWASC$ = "ö" THEN ZWASC$ = "Ö"
  114. 1130 IF ZWASC$ = "ü" THEN ZWASC$ = "Ü"
  115. 1140 MID$(a0$, I, 1) = ZWASC$
  116. 1150 NEXT I
  117. 1160 PUT #2
  118. 1170 RETURN
  119. 1180 REM ------------------------------ ende
  120. 1190 CLOSE : SYSTEM
  121.  
  122.