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