home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 06 / tricks / inliner.bas < prev    next >
BASIC Source File  |  1990-03-07  |  10KB  |  400 lines
  1. '* ------------------------------------------------------- *
  2. '*                     INLINER.BAS                         *
  3. '*            Inline-Generator für Turbo Basic.            *
  4. '*     Änderungen für Quick Basic sind mit )** markiert    *
  5. '*          (c) 1990 Karlheinz Rieth & TOOLBOX             *
  6. '* ------------------------------------------------------- *
  7. DEFINT A-Z:  DEFSTR Q-R
  8. KEY(10) ON: ON KEY(10) GOSUB ende
  9. ON ERROR GOTO er1
  10.  
  11. start:
  12. CLS
  13. PRINT "         Programm INLINER           ";
  14. PRINT "  (Beenden -> F10)"
  15. PRINT
  16. PRINT "Das Assemler-Inputfile muß den Regeln des";
  17. PRINT " DEBUG entsprechen"
  18. PRINT "Das Programm DEBUG.COM muß per PFAD erreichbar sein"
  19. PRINT "Die Steuerbefehle für DEBUG werden im Programm";
  20. PRINT " erzeugt"
  21. PRINT "Das Programm erzeugt eine Datei mit FüllBytes,in die"
  22. PRINT "                  DEBUG den Assembler-Code schreibt."
  23. PRINT "FüllByte ist NOP &H90, wenn 3 mal das Füllbyte";
  24. PRINT " erscheint,"
  25. PRINT "wird der Inline-Code abgebrochen.";
  26. PRINT " (FüllByte kann geändert werden.)"
  27. PRINT "Das CodeBinärFile kann z.B. mit $INLINE"; CHR$(34);
  28. PRINT "INLINE.BIN"; CHR$(34); " verwendet werden"
  29. PRINT "Wenn das INPUT-File *.BIN ist, wird es";
  30. PRINT " direkt gewandelt"
  31. PRINT
  32.  
  33. qq0 = "NOPDAT@@.$$$"
  34. qq1 = "INLINE.ASM"
  35. qq2 = "$$$.ASM"
  36.  
  37. PRINT "Inputfile *.ASM oder *.BIN Enter-> "; qq1;
  38. INPUT; " "; q
  39. q = UCASE$(q)
  40. IF q <> "" THEN qq1 = q
  41. LOCATE 13, 47
  42. PRINT "  "; qq1
  43.  
  44. IF LEN(q) > 3 THEN q = RIGHT$(qq1, 3)
  45. IF UCASE$(q) = "BIN" THEN bin = -1 ELSE bin = 0
  46.  
  47. pkt = INSTR(1, qq1, ".")
  48. IF pkt >= LEN( qq1 ) THEN pkt = 0    'wg. Fehler in TbBasic
  49. IF pkt = 0 THEN qq1 = qq1 + "."
  50. pkt = LEN(qq1)
  51. qlinks = UCASE$(LEFT$(qq1, pkt))
  52. qq3 = qlinks + "INL"
  53. qq4 = qlinks + "BIN"
  54. Anzahl = 10
  55.  
  56. PRINT "Inline-Outfile           Enter-> "; qq3;
  57. INPUT; " "; q
  58. q = UCASE$(q)
  59. IF q <> "" THEN qq3 = q
  60. LOCATE 14, 47: PRINT "  "; qq3
  61.  
  62. IF bin THEN
  63.   PRINT "*** "; qq1; " =Binär-File *** wird DIREKT";
  64.   PRINT " gewandelt !!!!"
  65.   qq4 = qq1
  66.   GOTO bin1
  67. END IF
  68. PRINT "Code-BinärFile           Enter-> "; qq4;
  69. INPUT ; " "; q
  70. q = UCASE$(q)
  71. IF q <> "" THEN qq4 = q
  72. LOCATE 15, 47 : PRINT "  "; qq4
  73.  
  74. bin1:
  75. PRINT "Inline's mit Hex oder Dez-Zahlen? H/D  Enter-> H";
  76. INPUT ; " "; q
  77. IF q = "" OR UCASE$(q) = "H" THEN
  78.   hx = -1
  79.   rinl = "HEX"
  80. ELSE
  81.   hx = 0
  82.   rinl = "DEZ"
  83. END IF
  84. LOCATE 16, 52: PRINT "  " + rinl
  85.  
  86. PRINT "Anzahl Elemente pro InlineZeile        Enter->10";
  87. INPUT ; " "; a
  88. IF a <> 0 THEN Anzahl = a
  89. LOCATE 17, 52: PRINT "  "; Anzahl
  90.  
  91. IF bin THEN GOTO Lauf
  92.  
  93. fuell:
  94. LOCATE 18, 1: PRINT SPACE$(79);
  95. LOCATE 18, 1: PRINT "FüllByte ist NOP &H90            "
  96. PRINT "Anderes Füllbyte,Hexzahl Eingeben";
  97. INPUT ; "       Enter->90 "; q
  98. q = UCASE$(q)
  99. IF q = "" THEN
  100.   fl$ = CHR$(&H90)
  101.   qfl = "&H90"
  102.   GOTO Lauf
  103. ELSE
  104.   GOSUB hex2dez
  105.   GOTO neufuell
  106. END IF
  107.  
  108. neufuell:
  109. LOCATE 19, 1: PRINT SPACE$(79);
  110. LOCATE 18, 1
  111. PRINT "FüllByte ist jetzt "; qfl;
  112. PRINT " ist das o.k.? J/N  Enter->J";
  113. INPUT ; " "; q
  114. IF q <> "" AND UCASE$(q) <> "J" THEN
  115.   GOTO fuell
  116. END IF
  117.  
  118. Lauf:
  119. CLS
  120. celin = 1
  121. IF bin THEN
  122.   PRINT "BIN-Input File              :"; qq4
  123.   GOTO bin2
  124. END IF
  125. PRINT "Assembler -File             :"; qq1
  126.  
  127. bin2:
  128. PRINT "Inline    -File             :"; qq3
  129. PRINT "Pro Inline-Zeile "; Anzahl; " Elemente in "; rinl;
  130. PRINT " Schreibweise"
  131. IF bin THEN
  132.   PRINT "****** DIREKTE-WANDLUNG des "; qq1; " Files !!!!"
  133.   GOTO bin3
  134. END IF
  135. PRINT "Füllbyte ist "; qfl; " nach 3 mal "; qfl; " wird";
  136. PRINT " Inlinecode beendet"
  137. PRINT "Temporäre Dateien NOPDAT@@.$$$ und $$$.ASM ";
  138. PRINT "werden erzeugt,und wieder golöscht"
  139. PRINT "BinärDatei "; qq4; " kann am ProgrammEnde";
  140. PRINT " gelöscht werden."
  141.  
  142. bin3:
  143. PRINT : PRINT "ist das o.k.? (Abbruch F10)   ";
  144. PRINT "  J/N  Enter->J";
  145. INPUT; " "; q
  146. IF UCASE$(q) = "N" THEN GOTO start
  147. CLS
  148. IF bin THEN GOTO bin4
  149.  
  150. qq = qq1
  151. OPEN "i", 1, qq         ' *.asm File einlesen
  152. OPEN "o", 2, qq2        ' daraus Input-Datei $$$.ASM mit
  153. PRINT #2, "a"           ' Steuerzeichen für Debug erzeugen
  154. DatLang = LOF(1)
  155. WHILE NOT EOF(1)
  156.   LINE INPUT #1, q
  157.   PRINT #2, q: celin = celin + 1
  158. WEND
  159. PRINT #2, ""
  160. PRINT #2, "w"
  161. PRINT #2, "q"
  162. CLOSE
  163.  
  164. OPEN "o", 1, qq0                  'Datei 'NOPDAT@@.$$$'
  165. q = STRING$(DatLang, fl$)       'mit FüllZeichen erzeugen
  166. PRINT #1, q
  167. CLOSE
  168.  
  169. q = "debug " + qq0 + " < " + qq2
  170. SHELL q         'Aufruf Debug:DEBUG NOPDAT@@.$$$ < $$$.ASM
  171. KILL qq2        '$$$.ASM löschen
  172.  
  173.                          'Datei NOPDAT@@.$$$ enthält jetzt
  174.                          'assemblierten Code und Füllzeichen
  175. qt = ""
  176. fl3$ = fl$ + fl$ + fl$
  177. qq = qq0
  178. OPEN "b", 1, qq
  179. Lang = LOF(1)
  180. FOR c = 1 TO Lang     'Füllzeichen entfernen
  181.   GET$ 1,1,q          ')**  q = INPUT$(1,1) 'QuickBasic
  182.   qt = qt + q
  183.   IF c > 2 THEN qt = RIGHT$(qt, 3)
  184.    'raus, wenn qt  3 Füllzeichen enthält und Zähler 3 zurück
  185.   IF qt = fl3$ THEN L2 = c - 3: EXIT FOR
  186. NEXT
  187. CLOSE
  188.  
  189. qq = qq0
  190. OPEN "b", 1, qq            'Lesen NOPDAT@@.$$$
  191. qqist = qq4
  192. GOSUB IstFile
  193. qq4 = qqist                'Test SchonDa ?
  194. OPEN "b", 2, qq4         'Schreiben *.BIN
  195. GET$ 1,L2,q        ')**  q = INPUT$(L2,1) 'QuickBasic
  196. PUT$ 2,q           ')**  PUT #2,1,q       'QuickBasic
  197. CLOSE
  198. KILL qq0              'NOPDAT@@.$$$ Löschen
  199.               '*.BIN Datei qq4 enhält code ohne Füllzeichen
  200.  
  201. bin4:
  202.  'Code auslesen und formatieren
  203. qt = ""
  204. d = Anzahl + 1: qi = "  $INLINE "
  205. qq = qq4
  206. OPEN "b", 1, qq: Lang = LOF(1)
  207. L1 = Lang + 1 + INT(Lang / d)
  208. DIM q(L1 + 1)
  209. FOR c = 0 TO L1 STEP d
  210. q(c) = qi
  211. NEXT                      '"$INLINE"->Array
  212. FOR c = 1 TO L1
  213.   IF q(c) = qi THEN GOTO ne1            ' Neue Zeile
  214.   IF EOF(1) THEN L2 = c - 1
  215.   GOTO clo
  216.   GET$ 1,1,q     ')** q = INPUT$(1, 1)  'QuickBasic
  217.   q(c) = STR$(ASC(q))
  218. ne1:
  219.   L2 = c
  220. NEXT
  221. clo:
  222. CLOSE
  223.                            'File mit Inline-Zeilen erzeugen
  224. rm = "  REM Inline-Code aus " + qq1
  225. qqist = qq3: GOSUB IstFile: qq3 = qqist
  226. OPEN "o", 3, qq3
  227. PRINT #3, rm;
  228. FOR c = 0 TO L2
  229.   IF q(c) = qi THEN             'wenn "$INLINE"
  230.     IF c <> L2 THEN             'nicht letztes Zeichen
  231.       PRINT #3, ""              'neue Zeile
  232.       PRINT #3, q(c);
  233.       GOTO ne2                  'nächstes Zeichen
  234.     ELSE
  235.       GOTO ne2
  236.     END IF
  237.   END IF
  238.   IF hx THEN                    'Wenn Hex-Zahlen
  239.     q(c) = HEX$(VAL(q(c)))
  240.     q(c) = "&H" + q(c)
  241.   END IF
  242.   IF (q(c + 1) <> qi) THEN       'plus Komma,wenn
  243.     IF q(c + 1) <> "" THEN       'kein Zeilen-Ende
  244.       IF c <> L2 THEN
  245.         q(c) = q(c) + ","
  246.       END IF
  247.     END IF
  248.   END IF
  249.   IF LEFT$(q(c), 1) = " " THEN 'führendes Leerzeichen weg
  250.     q(c) = RIGHT$(q(c), LEN(q(c)) - 1)
  251.   END IF
  252.   PRINT #3, q(c);
  253. ne2:
  254. NEXT
  255. CLOSE         ' qq3
  256.  
  257. GOSUB unten             ' Job erledigt,InlineCode in *.INL
  258. IF bin THEN GOTO bin5
  259. PRINT "Soll Binärdatei "; qq4; " gelöscht werden ? J/N ";
  260. PRINT "  Enter->Ja";
  261. GOSUB Taste
  262. IF q <> "N" THEN KILL qq4
  263. GOSUB unten
  264. FOR c = 0 TO 1000: NEXT
  265.  
  266. bin5:
  267. PRINT "Datei "; qq3; " auf Bildschirm ausgeben ? J/N  ";
  268. PRINT "  Enter->Ja";
  269. GOSUB Taste
  270. GOSUB unten
  271. IF q <> "N" THEN GOSUB zeige
  272. PRINT "Die Datei mit Inline-Statements "; qq3;
  273. PRINT " kann mit ^KR in den Editor übernommen werden !";
  274. PRINT "           Programm beendet !";
  275. END
  276.  
  277. Taste:
  278.   q = "": WHILE q <> "": q = INKEY$: WEND
  279.   q = "": WHILE q = "": q = UCASE$(INKEY$): WEND
  280. RETURN
  281.  
  282. unten:
  283.   FOR c = 22 TO 24
  284.     LOCATE c, 1: PRINT SPACE$(79);
  285.   NEXT
  286.   LOCATE 22, 1
  287. RETURN
  288.  
  289. hex2dez:
  290.   IF LEN(q) >= 2 THEN q = RIGHT$(q, 2)
  291.   qfl = "&H" + q                         '&H90
  292.   fl = VAL(qfl)                          '144
  293.   fl$ = CHR$(fl)                         'É
  294. RETURN
  295.  
  296. zeige:
  297.   IF celin > 19 THEN
  298.     CALL SCRFREI(q, 19, 24): LOCATE 19, 1
  299.   ELSE
  300.     CALL SCRFREI(q, celin + 2, celin + 4)
  301.     LOCATE celin + 3, 1
  302.   END IF
  303.   qq = qq3
  304.   OPEN "i", 1, qq3
  305.   WHILE NOT EOF(1)
  306.     LINE INPUT #1, q: PRINT q
  307.   WEND
  308.   CLOSE
  309. RETURN
  310.  
  311. ende:
  312.   PRINT "Abbruch mit F10"
  313. END
  314.  
  315. er1:
  316.   IF ERR = 53 AND ist THEN
  317.     ist = 0: RESUME schonda
  318.   END IF
  319.  
  320.   IF ERR = 53 OR ERR = 64 OR ERR = 76 THEN
  321.     IF ist THEN qq = qqist
  322.     CALL CPOS(cl, cs)
  323.     CALL SCRFREI(Bild$, 19, 24)
  324.     PRINT STRING$(79, "*")
  325.     PRINT "Datei "; qq; " nicht gefunden !"
  326.     INPUT ; "DateiNamen neu eingeben ( * ->NeuStart)"; qq
  327.     LOCATE 21, 40: PRINT "   " + UCASE$(qq);
  328.     FOR c = 0 TO 2000: NEXT
  329.     IF ist THEN                'wenn err 64,76 bei Out-Datei
  330.       ist = 0: qqist = qq
  331.       RESUME schonda
  332.     END IF
  333.     IF qq = CHR$(42) THEN GOTO start
  334.   ELSE
  335.     PRINT "Fehler "; ERR; "Taste -> END"
  336.     GOSUB Taste: GOTO ende1
  337.   END IF
  338.     LOCATE 19, 1: PRINT Bild$; : Bild$ = ""
  339.     CALL CREST(cl, cs)
  340. RESUME
  341.  
  342. ende1:
  343.   LOCATE 19, 1: PRINT Bild$; : Bild$ = ""
  344.   LOCATE 24, 50: PRINT "**  Programm beendet  **";
  345. END
  346.  
  347. IstFile:        'Die Var.cl,cs,qqist,ist,Bild$,q sind Global
  348.   ist = -1
  349.   OPEN "i", 20, qqist             'DateiNummer 20 verwendet!
  350. schonda:
  351.   IF NOT ist THEN GOTO raus1         'nicht da
  352.   ist = 0
  353.   CLOSE #20
  354.   CALL CPOS(cl, cs)                  'CursorPos sichern
  355.   CALL SCRFREI(Bild$, 20, 24)        'FensterInhalt sichern
  356. frage:
  357.   LOCATE 20, 1: PRINT STRING$(79, "*");
  358.   PRINT "Datei "; qqist; " existiert";
  359.   PRINT " bereits ! Überschreiben ? J/N"
  360.   GOSUB Taste
  361.   IF q = "J" THEN
  362.     GOTO exif
  363.   ELSEIF q = "N" THEN
  364.     INPUT ; "Neuen DateiNamen eingeben :"; qqist
  365.     LOCATE 22, 28: PRINT UCASE$(qqist)
  366.   ELSE
  367.     GOTO frage
  368.   END IF
  369. exif:
  370.   LOCATE 20, 1: PRINT Bild$;         'FensterInhalt restaur.
  371.   CALL CREST(cl, cs)                 'CursorPos restaurieren
  372. raus1:
  373. RETURN
  374.  
  375. SUB CPOS (cline, cstelle)            'CursorPos sichern
  376.   cstelle = POS(cstelle): cline = CSRLIN
  377. END SUB
  378.  
  379. SUB CREST (cline, cstelle)           'CursorPos restaurieren
  380.   LOCATE cline, cstelle
  381. END SUB
  382.  
  383. SUB SCRFREI (Bild$, AbZeile, BisZeile)       'Fenster
  384.   qb = ""
  385.   FOR c = AbZeile TO BisZeile
  386.     FOR d = 1 TO 80
  387.       q = CHR$(SCREEN(c, d))                 'sichern
  388.       qb = qb + q
  389.   NEXT d, c
  390.  
  391.   FOR c = AbZeile TO BisZeile
  392.     LOCATE c, 1
  393.     PRINT SPACE$(79);                        'und löschen
  394.   NEXT
  395.   LOCATE AbZeile, 1
  396.   Bild$ = qb: qb = ""
  397. END SUB
  398. '* ------------------------------------------------------- *
  399. '*                 Ende von INLINER.BAS                    *
  400.