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