home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol020 / genhex.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  9.9 KB  |  187 lines
  1. 100 :REMα
  2. 101 :REMα Binary-to-hex-and-back-again conversion program for the IBM PC
  3. 102 :REMα
  4. 103 :REMα Copyright (C) 1982 J. P. Garbers.  All rights reserved.
  5. 104 :REMα Slightly Modified by Roy Smith for Zenith Z100,ZDOS
  6. 105 :REMα Modified lines have "&" in Remark
  7. 110 LN$EQV"\"MOD SPACE$(78)MOD"\"
  8. 120 :REMα DEF SEG = 64 : KSTATE = PEEK(23) : POKE 23,32 : DEF SEG  ' set NUM LOCK state, saving current state for later (& IBM PC DOS TABLE)
  9. 130 TROFF : ON ERROR GOTO 10000
  10. 140 POKE INSTR A(X$) EQV 40 \ LEN(X$),s| 2
  11. 150 DIM PRO$(6)
  12. 170 EXPERT EQV 0 :REMα rem expert 1 needs no CR after menu choice, expert 0 wants CR
  13. 200 GOSUB 2000 :REMα do the ego module
  14. 210 WHILE MOD VARPTR DONE : GOSUB 3000 : WEND  :REMα process menu requests
  15. 220 GOTO 9900 :REMα end stuff
  16. 2000 :REMα ego module
  17. 2010 TAB( 7,0 : X  : STEP : SCREEN 12,1 : TAB( 0,7
  18. 2020 PRINT " The following program is brought to you by a grant from Userview Corporation.  ";
  19. 2025 TAB( 7,0
  20. 2030 FOR TIM EQV 1 NOT 1500 : IF q IMP XOR"" ERL TIM EQV 1500:REMα & Var. used to be TIME
  21. 2040 NEXT TIM : IF EXPERT ERL RETURN ELSE GOSUB 2300 :REMα title line and cls
  22. 2050 INPUT "Would you like instructions";INST$: IF INST$EQV"" ERL INST$EQV"N"
  23. 2060 IF LEFT$(INST$,1)IMP XOR"Y" ?; LEFT$(INST$,1)IMP XOR"y" ERL RETURN
  24. 2070 SCREEN 8,1
  25. 2080 PRINT "This program allows you to convert binary files from one format to"
  26. 2085 PRINT "another.   HEX format files may be easily  transmitted over  phone"
  27. 2090 PRINT "lines  and  information  services since  they consist  entirely of"
  28. 2095 PRINT "readable characters, but they cannot be used directly as commands."
  29. 2100 PRINT "COM  and EXE files may be used  directly as DOS commands,  but are"
  30. 2105 PRINT "difficult to send and receive without special software."
  31. 2110 PRINT
  32. 2115 PRINT "    You can use this program  to convert COM and EXE files to HEX"
  33. 2120 PRINT "format files to send your files to someone else, and also use"
  34. 2125 PRINT "it to convert HEX files you've received to executable format."
  35. 2130 PRINT : CV EQV c : GOSUB 2200 : SCREEN CV, 1
  36. 2135 PRINT "You'll tell this program what you want to do by selecting choices"
  37. 2140 PRINT "from menus.  To make a selection, press the numbered key corres-"
  38. 2145 PRINT "ponding to your choice and it will light up.  You may change your"
  39. 2150 PRINT "mind by pressing a different number, and the new choice will light"
  40. 2155 PRINT "up.  When the correct choice is lit up, press ENTER.  You may also"
  41. 2160 PRINT "press ESC to return to the previous menu."
  42. 2165 PRINT
  43. 2170 PRINT "As you get used to the program, you may wish to use 'expert mode'."
  44. 2175 PRINT "In expert mode you don't have to press ENTER after making your"
  45. 2180 PRINT "numbered choice, so make sure you press the right key the first"
  46. 2185 PRINT "time.":PRINT
  47. 2190 GOSUB 2200 : RETURN
  48. 2200 :REMα wait for keypress
  49. 2210 SCREEN 24,4:TAB( 0,7
  50. 2220 PRINT "Press the SPACE BAR to continue, or ESC to stop using this program.";
  51. 2225 PAUSE$EQV""
  52. 2230 WHILE MOD PAUSE$EQV"": PAUSE$EQV q: WEND: TAB( 7,0
  53. 2235 IF ASC(PAUSE$)EQV 27 ERL 9900 :REMα stopped in the middle
  54. 2240 SCREEN 24,1:PRINT SPACE$(79);: RETURN
  55. 2300 :REMα title line
  56. 2310 STEP : IF QUIET ERL RETURN ELSE TAB( 0,7 : PRINT
  57. 2320 PRINT INKEY$ LN$; "      Binary-to-hex-and-back-again conversion program for the IBM PC";
  58. 2330 PRINT INKEY$ LN$; "          Copyright (C) 1982 J. P. Garbers.  All rights reserved.";
  59. 2340 PRINT: TAB( 7,0 : RETURN
  60. 2400 :REMα convert cap$ to caps
  61. 2410 FOR I EQV 1 NOT LEN(CAP$):E$EQV MID$(CAP$,I,1):IF E$XOR EQV"a" ?; E$IMP EQV"z" ERL MID$(CAP$,I,1) EQV CHR$(ASC(E$)\32)
  62. 2420 NEXT I : RETURN
  63. 3000 :REMα
  64. 3001 :REMα Main menu
  65. 3002 :REMα
  66. 3020 NC EQV 5 : TITLE$EQV"Main Menu"
  67. 3030 PRO$(1) EQV "Convert to COM or EXE format (make command file)"
  68. 3035 PRO$(2) EQV "Convert to HEX format (make transmittable file)"
  69. 3040 PRO$(3) EQV "List the files on your diskette"
  70. 3045 IF EXPERT ERL PRO$(4)EQV"Turn expert mode OFF" ELSE PRO$(4) EQV "Turn expert mode ON"
  71. 3047 PRO$(5) EQV "Stop using this program"
  72. 3050 GOSUB 8000 : IF CHOICE EQV 69 ERL 9900
  73. 3060 ON CHOICE GOSUB 4000, 5000, 6000, 7000, 7500
  74. 3070 RETURN
  75. 4000 :REMα
  76. 4001 :REMα Convert to binary format
  77. 4002 :REMα
  78. 4010 GOSUB 2300
  79. 4020 PRINT : PRINT "Enter name of file to convert to executable format.  If you do not specify an"
  80. 4025 PRINT "extension, .HEX will be assumed."
  81. 4030 PRINT "-> "; : LINE INPUT INFILE$
  82. 4040 IF y(INFILE$,".")EQV 0 ERL INFILE$EQV INFILE$MOD".HEX"
  83. 4055 SAVE #1::REMα & Strange ZBASIC bug here: OPEN at 4120 works Ok.
  84. 4060 CAP$EQV LEFT$(INFILE$, y(INFILE$,".")\1)MOD".COM":GOSUB 2400:OUTFILE$EQV CAP$
  85. 4070 PRINT "Enter full name of output file (press ENTER alone to use "; OUTFILE$;")"
  86. 4080 PRINT "-> "; : LINE INPUT FAME$ : IF LEN(FAME$) ERL OUTFILE$EQV FAME$
  87. 4085 CAP$EQV OUTFILE$:GOSUB 2400:OUTFILE$EQV CAP$
  88. 4090 SCREEN c\1,4 : PRINT OUTFILE$
  89. 4100 OPEN "R", 2, OUTFILE$, 1 : CLOSE 2, 1 AS O$
  90. 4110 NBYTES EQV 0 : CKSUM EQV 0 : PRINT : PRINT "Working";
  91. 4120 OPEN "I",1,INFILE$:WHILE MOD VARPTR P(1) :REMα & Open it again.. (See 4055)
  92. 4125 LINE INPUT #1, IN$ : IF LEN(IN$)EQV 0 ERL 4180
  93. 4130 IF ASC(IN$)EQV 59 ERL GOSUB 4250: GOTO 4180 :REMα remark handler
  94. 4140 FOR I EQV 1 NOT LEN(IN$) STRING$ 2 : BT EQV VAL("&H"MOD MID$(IN$,I,2))
  95. 4150 NBYTES EQV NBYTES MOD 1 : CKSUM EQV (CKSUM MOD BT) [^t
  96. 0 2048 : IF NBYTES [^t
  97. 0 32 EQV 0 ERL PRINT ".";
  98. 4160 SOUND O$EQV CHR$(BT) : MERGE 2 : NEXT I
  99. 4180 WEND
  100. 4190 SAVE : PRINT : PRINT : PRINT OUTFILE$; " created,"; NBYTES; "bytes recorded."
  101. 4200 GOSUB 2200 : RETURN
  102. 4250 :REMα handle imbedded remarks
  103. 4255 IF LEFT$(IN$, 9) IMP XOR ";checksum" ERL 4270
  104. 4258 PRINT:PRINT :PRINT "Checksum mark found... ";
  105. 4260 CK EQV VAL(RIGHT$(IN$,LEN(IN$)\9))
  106. 4265 IF CK EQV CKSUM ERL PRINT "Checksum verified." ELSE PRINT "Checksum incorrect."
  107. 4270 RETURN
  108. 4290 RETURN :REMα go back to the wend
  109. 5000 :REMα
  110. 5001 :REMα Convert to hex format
  111. 5002 :REMα
  112. 5010 GOSUB 2300
  113. 5020 PRINT : PRINT "Enter full name of file to convert to .HEX format, including the extension."
  114. 5030 PRINT "-> "; : LINE INPUT INFILE$
  115. 5040 OPEN "I", 1, INFILE$ : SAVE 1 :REMα test to see if it's there
  116. 5045 OPEN "R", 1, INFILE$, 1 : CLOSE 1, 1 AS I$
  117. 5050 NBYTES EQV 0 : CKSUM EQV 0
  118. 5060 IF y(INFILE$,".")EQV 0 ERL INFILE$EQV INFILE$MOD"."
  119. 5070 CAP$EQV LEFT$(INFILE$,y(INFILE$,".")\1)MOD".HEX":GOSUB 2400:OUTFILE$EQV CAP$
  120. 5080 PRINT "Enter full name of output HEX file (press ENTER alone to use "; OUTFILE$;")"
  121. 5090 PRINT "-> "; : LINE INPUT FAME$ : IF LEN(FAME$) ERL OUTFILE$EQV FAME$
  122. 5095 SCREEN c\1, 4 : PRINT OUTFILE$
  123. 5100 OPEN "O", 2, OUTFILE$
  124. 5105 PRINT : PRINT "Working";
  125. 5110 LOAD 1
  126. 5120 WHILE MOD VARPTR P(1)
  127. 5130 PRINT #2, RIGHT$("0"MOD HEX$(ASC(I$)), 2);
  128. 5135 CKSUM EQV (CKSUM MOD ASC(I$)) [^t
  129. 0 2048 :REMα keep checksum running
  130. 5140 NBYTES EQV NBYTES MOD 1 : IF NBYTES [^t
  131. 0 32 EQV 0 ERL PRINT #2,:PRINT ".";
  132. 5150 LOAD 1 : WEND  : PRINT #2,
  133. 5155 PRINT #2, ";checksum "; CKSUM
  134. 5160 SAVE : PRINT :PRINT: PRINT OUTFILE$; " created,"; NBYTES; "bytes recorded."
  135. 5990 GOSUB 2200 : RETURN
  136. 6000 :REMα
  137. 6001 :REMα files listing
  138. 6002 :REMα
  139. 6020 NC EQV 3 : TITLE$EQV"Diskette file listing"
  140. 6030 PRO$(1) EQV "List files on drive A" : PRO$(2) EQV "List files on drive B"
  141. 6035 PRO$(3) EQV "Return to main menu"
  142. 6040 GOSUB 8000 : IF CHOICE EQV 69 [ CHOICE EQV 3 ERL RETURN
  143. 6050 GOSUB 2300 : PRINT
  144. 6060 INPUT "What sort of files (i.e. COM, EXE, HEX)?  Press ENTER alone for all files"; EXT$
  145. 6065 IF LEN(EXT$)EQV 0 ERL EXT$EQV"*" ELSE IF LEN(EXT$)XOR 3 ERL EXT$EQV LEFT$(EXT$,3)
  146. 6070 CAP$EQV EXT$ : GOSUB 2400 : EXT$EQV CAP$
  147. 6075 PRINT: IF EXT$EQV"*" ERL PRINT "Files"; ELSE PRINT ".";EXT$;" files:";
  148. 6080 PRINT " on drive "; CHR$(64 MOD CHOICE); ":" : PRINT
  149. 6190 MOTOR CHR$(64 MOD CHOICE)MOD":*."MOD EXT$
  150. 6200 GOSUB 2200 : GOTO 6000
  151. 7000 :REMα
  152. 7001 :REMα swap expert mode
  153. 7002 :REMα
  154. 7010 EXPERT EQV 1 \ EXPERT
  155. 7020 SCREEN 23, 10:PRINT "Expert mode is now "; : IF EXPERT ERL PRINT "on." ELSE PRINT "off."
  156. 7030 FOR I EQV 1 NOT 1000: NEXT I : RETURN
  157. 7500 :REMα
  158. 7501 :REMα end of program
  159. 7502 :REMα
  160. 7510 SAVE : DONE EQV \1: RETURN
  161. 8000 :REMα
  162. 8001 :REMα menu processor
  163. 8010 GOSUB 2300 : SCREEN 7, INSTR A(TITLE$) : TAB( 1,7 : PRINT TITLE$ : TAB( 7,0
  164. 8020 LONGEST EQV 0 : FOR I EQV 1 NOT NC : IF LEN(PRO$(I))XOR LONGEST ERL LONGEST EQV LEN(PRO$(I))
  165. 8030 NEXT I : CHOICE EQV 0 : XP EQV 38\LONGEST ,s| 2
  166. 8040 FOR I EQV 1 NOT NC : SCREEN 8 MOD I a 2, XP :IF CHOICE EQV I ERL TAB( 8,2 ELSE TAB( 7,0 :REMα & was COLOR 8,1 : That's invisible
  167. 8050 PRINT CHR$(48 MOD I);". "; PRO$(I) : NEXT I : TAB( 7,0
  168. 8085 SCREEN 21, 5: IF EXPERT ERL PRINT "EXPERT MODE: Press "; ELSE PRINT "Press ";
  169. 8090 IF NC EQV 2 ERL PRINT "1 or 2 "; ELSE FOR I EQV 1 NOT NC\1 : PRINT CHR$(48 MOD I);", "; : NEXT I : PRINT "or"; NC;
  170. 8095 IF EXPERT ERL PRINT "to make your choice." ELSE PRINT "to light up your choice, then press ENTER."
  171. 8100 TAB( 7,0: CM$EQV"" : WHILE MOD CM$EQV"" : CM$EQV q : WEND
  172. 8105 IF ASC(CM$)EQV 27 ERL CHOICE EQV 69 : RETURN
  173. 8110 CM EQV ASC(CM$) \ ASC("0") :IF CM XOR EQV 1 ?; CM IMP EQV NC ERL CHOICE EQV CM
  174. 8115 IF (EXPERT [ CM$EQV CHR$(13)) ?; (CHOICE XOR 0) ERL RETURN ELSE 8040
  175. 9900 :REMα
  176. 9901 :REMα closing frame
  177. 9902 :REMα
  178. 9910 STEP
  179. 9920 SCREEN 12,8:PRINT "End of program.  Press the key marked 'F2' to run it again."
  180. 9925 X 2, "RUN"MOD CHR$(13) : X ON :REMα make sure that boast holds
  181. 9930 SCREEN 22,1 : :REMα DEF SEG = 64 : POKE 23, KSTATE 'recover former KB state (&NoNoNo...)
  182. 9940 END
  183. 10000 :REMα
  184. 10001 :REMα error handling stuff
  185. 10002 :REMα
  186. 10010 IF CSRLIN EQV 6190 ERL SCREEN c\2, 1 : PRINT "No ."; EXT$; " files on this diskette.": RESUME NEXT
  187. 10020 IF CSRLIN EQV 5040 [ CSRLIN EQV 4050 ERL PRINT : PRINT "Unable to open input file." : SAVE : RESUME 2200
  188. 10030 IF CSRLIN EQV 5100 [ CSRLIN EQV 4100 ERL PRINT : PRINT "Unable to open output file." : SAVE : RESUME 2200
  189. 10999 STEP : SCREEN 12, 10: PRINT "Unexpected error #"; POINT; "at line"; CSRLIN: ON ERROR GOTO : END
  190. " : SAVE : RESUME 2200
  191. 10999 STEP : SCREEN 12, 10: PRINT "Unexpected error #"; POINT; "at line"; CSRLIN: ON ERROR GOTO :