home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / decode / 3_4encod.bas < prev    next >
BASIC Source File  |  1994-03-04  |  12KB  |  375 lines
  1. Date:         Fri, 22 Jan 88 09:55:20 EST
  2. From:         J Law <PHYJLAW%UOGUELPH.BITNET@CUNYVM.CUNY.EDU>
  3. Subject:      Re: Info-IBMPC Digest V7 #3
  4. To:           Gregory Hicks COMFLEACTS <hicks@walker-emh.arpa>
  5.  
  6. Util3- program           by J Law, Physics, UOGUELPH, 1986
  7.                          Current Version 2.2  1987
  8.  
  9.       This program is written in Microsoft Basic and should be compiled by
  10. version 2 of Bascom or Turbo Basic. You may also run the source form under
  11. Basica Ver 2 or greater but it will be slow! DOS 3.x preferred for
  12. compiled version.
  13.  
  14.       Objectives:  Util3 allows you to unload a binary file or a document
  15. file that has control characters in, eg wordstar or wordperfect files,
  16. into an ASCII file which you can the upload to a mainframe and shipped
  17. via NETNORTH/BITNET etc to your colleagues, who would then use their
  18. version of UTIL3 to decode the file back to its original form.
  19.  
  20.       Encoding/Decoding:  I use a 4 byte for 3 byte encode, so that
  21. every 3 bytes are expanded into 4 bytes, each byte corresponds to the
  22. 6 bits from the original 3x8=24 bits.
  23.  
  24.       byte 3  byte 2      byte 1
  25.     xxxxxxxx yyyyyyyy     zzzzzzzz
  26.    _|    ||     ||_        ||    |__
  27.   /      |\      \ \       |\      \
  28.   00xxxxxx 00xxyyyy 00yyyyzz 00zzzzzz
  29.  
  30.   byte 4   byte 3   byte 2   byte 1
  31.  
  32.       These 4 bytes have values of 0 to 2^6-1=63. The mapping I use is:
  33. defined in line 1030 of the program
  34.  
  35. mapping @ABCDEFGHIJKLMNOPQRSTUVWXYZ012345abcdefghijklmnopqrstuvwxyz6789?
  36.  
  37. char#   00000000001..............                                 ... 66
  38.         01234567890..............                                 ... 23
  39.  
  40.  
  41. Decoding is the inverse.  However to provide some error testing, the file
  42. written out is as follows:
  43.  
  44.    id    name 12 chars                                    byte in hex form
  45. |      |          |                                                    \ \
  46. :UTIL3.2util3.exe                                                        FF
  47. :MiEyA7D@@@5@@@@@??O@@@H@@@5jA@@@1@@@@@@@@@@UUIePOAbPAMURC8rPoAW3revYhQGH31
  48. |                                                                       / /
  49. \ coded data                                      2 hex values representing
  50.                                              byte value checksum for the
  51.                                              coded    data modulo Hex100
  52.           ie sum up all bytes mod H100, then last byte is
  53.                   Hex100 - sum
  54.  
  55. last line  :00000001FF           simply for identification
  56.  
  57. Comments:
  58.        Although this program can be used on its own, note that your file
  59. will get at least 30% larger.  It is best used with a file squeezer program
  60. like arc, pkarc or sq.exe all of which are in the  shareware
  61. arena. If you use arc to compress a program file for example, then util3
  62. will at most re expand it to its original size, but you can then send this
  63. file thro a mainframe as it is ASCII.
  64.  
  65.  
  66. When run, the following screen should appear:
  67. ====================================================
  68.             UTIL3 - PROGRAM  VER 2.2
  69.      J LAW PHYSICS  UoGuelph  October 1987
  70.     Ascii coding of files for electronic transfer
  71.         using a 3 byte for 4 byte coding
  72.  
  73. (1) convert file.??? TO file.3T4
  74. (2) convert file.3T4 TO file.???
  75.  
  76. (3) uudecode file
  77.  
  78. (0) EXIT
  79.  
  80.  
  81. CHOOSE A NUMBER:
  82. ===================================================
  83.  
  84. Choice 1 will convert anyfile.ext to anyfile.3t4.
  85. Choice 2 will convert anyfile.3t4 back to filename.ext.
  86. Choice 3 will uudecode files from Simtel20.arpa, which are uuencoded.
  87.  
  88. This is placed in the public domain for all to use & enjoy.
  89.  
  90.  
  91. Any comments or modifications to speed up program are welcome:
  92.  
  93.  
  94. Dr J. Law
  95. Physics Dept
  96. University of Guelph
  97. Guelph On Canada.
  98. N1G 2W1
  99.  
  100. Bitnet/NetNorth: Phyjlaw @ Uoguelph
  101. ===========Program util3.bas============================
  102.  
  103. 1000 DEFINT A-Z
  104. 1010 DIM A(30,80),BB(30,80),buf(1000)
  105. 1030 A2$="@ABCDEFGHIJKLMNOPQRSTUVWXYZ012345abcdefghijklmnopqrstuvwxyz6789?"
  106. 1040 A$=A2$'SETUP FOR VERSION 2
  107. 1050 LOCATE 1,1,1 :B1$=""
  108. 1060 CLS:CLOSE:A$=A2$ :i19=71:i15=54
  109. 1070 PRINT    "            UTIL3 - PROGRAM  VER 2.2    "
  110. 1080 PRINT    "      J LAW PHYSICS  UoGuelph  October 1987   "
  111. 1090 PRINT    "   Ascii coding of files for electronic transfer  "
  112. 1100 PRINT    "   using a 3 byte for 4 byte coding               "
  113. 1110 PRINT    " "
  114. 1120 PRINT    "(1) convert file.??? TO file.3T4 "
  115. 1130 PRINT    "(2) convert file.3T4 TO file.??? "
  116. 1140 PRINT
  117. 1145 PRINT    "(3) uudecode file"
  118. 1147 PRINT
  119. 1150 PRINT    "(0) EXIT"
  120. 1160 PRINT    " "
  121. 1170 PRINT    " "
  122. 1180 LINE INPUT "CHOOSE A NUMBER:";VA$:IF VA$="" THEN 1050
  123. 1190 PRINT    " " :VA=VAL(VA$)
  124. 1200 IF VA=0 THEN STOP
  125. 1210 IF VA>3 THEN 1050
  126. 1215 IF  VA=3  THEN 3000   ' uudecode
  127. 1220 LINE INPUT "INPUT  FILENAME.EXT : ";N$
  128. 1230 'IF VA=2 THEN  LINE INPUT "OUTPUT FILENAME.EXT : ";N2$
  129. 1240 GOSUB 2140
  130. 1250 IF  VA=1  THEN 2590   ' CONVERT TO 3T4
  131. 1260 IF  VA=2  THEN 1680   ' 3T4 TO ???
  132. 1270 '
  133. 1280 'WRITE FILE :..20..CHARS..
  134. 1290 GOSUB 2210   'UNLOAD 3 TO 4
  135. 1300 FOR IM1=0 TO IM1X
  136. 1310 V$="" :CHKSUM=0
  137. 1320 FOR J=0 TO i19
  138. 1330 AIJ=BB(IM1,J)
  139. 1340 V1$=CHR$(AIJ):CHKSUM=(CHKSUM+AIJ) MOD &H100
  140. 1350 '
  141. 1360 V$=V$+V1$
  142. 1370 NEXT J
  143. 1380 CK=(&H100-CHKSUM)
  144. 1390 V3$=HEX$(CK):IF LEN(V3$)=1 THEN V3$="0"+V3$
  145. 1400 IF LEN(V3$)>=3 THEN V3$=RIGHT$(V3$,2)
  146. 1410 PRINT #2,":"+V$+V3$
  147. 1420 '
  148. 1430 NEXT IM1
  149. 1440 RETURN
  150. 1460 OPEN "R",#1,N1$,i15
  151. 1470 FIELD #1,i15 AS B$
  152. 1475 mx=lof(1)/i15
  153. 1480 OPEN "O",#2,N2$
  154. 1490 TB=0:IM1X=0
  155. 1500 GOSUB 2100                  'WRITE HEADER
  156. 1502 for ibyte=1 to mx+1
  157. 1510 GOSUB 1570                   'get com file
  158. 1530 GOSUB  1280                  'write hex file
  159. 1540 next ibyte
  160. 1550 PRINT #2,":00000001FF" :CLOSE
  161. 1560 GOTO 1050       'CLOSE EXIT
  162. 1570 'READ COM OR EXE FILE
  163. 1590 GET #1:B1$=B$
  164. 1600 I1=0:J1=0:IM1X=0
  165. 1610 N=LEN(B1$):I=1
  166. 1620 AA$=MID$(B1$,I,1):I=I+1
  167. 1630 A(I1,J1)=ASC(AA$)
  168. 1640 J1=J1+1:IF J1<i15 THEN 1660
  169. 1650 J1=0 :IM1X=I1:I1=I1+1
  170. 1660 IF I<=N THEN 1620
  171. 1670 RETURN
  172. 1675 '
  173. 1680 CHKERR=0 :IH=0
  174. 1690 ON ERROR GOTO 2670
  175. 1700  OPEN "I",#1,N1$
  176. 1710 LINE INPUT #1,V$
  177. 1720 TC=INSTR(V$,":UTIL3"):IF TC<>0 THEN 1750
  178. 1730 IF IH <= 10 THEN IH=IH+1:GOTO 1710 ELSE GOTO 2500
  179. 1750 N2$=MID$(V$,9,12):PRINT "DECODING ";N2$
  180. 1755 if len(v$)>30 then i15=54:i19=71 ELSE I15=15:I19=19
  181. 1760 GOTO 2720
  182. 1770 CLOSE #2 : recno#=1
  183. 1780 OPEN "R",#2,N2$,i15
  184. 1782 field #2, i15 as n$
  185. 1790 GOSUB 1880 'read&write
  186. 1800 IF TB<>0 THEN 1830
  187. 1810 '      GOSUB 2030   write
  188. 1820 GOTO 1790
  189. 1830 CLOSE
  190. 1840 IF CHKERR<>0 THEN GOSUB 2540
  191. 1850 GOTO 1050
  192. 1860 '
  193. 1870 'read in hex file
  194. 1880 '
  195. 1890 IF EOF(1) THEN RETURN
  196. 1900 LINE INPUT #1,V$
  197. 1902 tb=instr(v$,":"):if tb=0 then 1890
  198. 1910 TB=INSTR(V$,":00000001FF"):IF TB<>0 THEN RETURN
  199. 1920 CHKSUM=0
  200. 1930 FOR J=0 TO i19
  201. 1940 BB(0,J)=ASC(MID$(V$,2+J,1))
  202. 1950 CHKSUM=(CHKSUM+BB(0,J)) MOD &H100
  203. 1960 NEXT J
  204. 1970 CK=(&H100-CHKSUM)
  205. 1980 V3$=HEX$(CK):IF LEN(V3$)=1 THEN V3$="0"+V3$
  206. 1990 IF LEN(V3$)>=3 THEN V3$=RIGHT$(V3$,2)
  207. 2000 IF V3$<>RIGHT$(V$,2) THEN CHKERR=CHKERR+1
  208. 2360 ' 4 TO 3 MAPPING
  209. 2370 K=0
  210. 2380 FOR J=0 TO i19 STEP 4
  211. 2390 A1=BB(0,J):A2=BB(0,J+1):A3=BB(0,J+2):A4=BB(0,J+3)
  212. 2400 A1=INSTR(A$,CHR$(A1))-1
  213. 2410 A2=INSTR(A$,CHR$(A2))-1
  214. 2420 A3=INSTR(A$,CHR$(A3))-1
  215. 2430 A4=INSTR(A$,CHR$(A4))-1
  216. 2440 B1=(A2 AND &H03)*64+A1:A(0,K)=B1
  217. 2450 B1=(A2 AND &H3C)/4+(A3 AND &H0F)*16 :A(0,K+1)=B1
  218. 2460 B1=(A3 AND &H30)/16+(A4 AND &H3F)*4 :A(0,K+2)=B1
  219. 2470 K=K+3
  220. 2480 NEXT
  221. 2030 ' print to com file
  222. 2040 an$=""
  223. 2050 FOR J=0 TO i15-1
  224. 2060 an$=an$+chr$(A(0,J))
  225. 2070 NEXT
  226. 2075 lset n$=an$
  227. 2080 Put #2,recno#:recno#=recno#+1
  228. 2090 RETURN
  229. 2100 'HEADER WRITTEN
  230. 2110 B2$=":UTIL3.2"+N1$+SPACE$(i19-6-LEN(N1$))+"FF"
  231. 2120 PRINT #2,B2$
  232. 2130 RETURN
  233. 2140  I=INSTR(N$,"."):IF I=0 THEN 2180
  234. 2150  IF VA=1 OR VA=4 THEN N1$=N$:N2$=MID$(N$,1,I)+"3T4"
  235. 2160  IF VA=2 THEN N1$=MID$(N$,1,I)+"3T4"
  236. 2170  RETURN
  237. 2180  IF VA=1 OR VA=4 THEN N1$=N$:N2$=N$+".3T4"
  238. 2190  IF VA=2 THEN N1$=N$+".3T4"
  239. 2200  RETURN
  240. 2210 ' 3 TO 4 MAPPING
  241. 2220 FOR IM1= 0 TO IM1X
  242. 2230 K=0
  243. 2240 FOR J=0 TO i15-1 STEP 3
  244. 2250 A1=A(IM1,J):A2=A(IM1,J+1):A3=A(IM1,J+2)
  245. 2260 B1= A1 AND 63
  246. 2270 BB(IM1,K)=ASC(MID$(A$,B1+1,1))
  247. 2280 B1= A1 AND &HC0:B1=B1/64+4*(A2 AND &HF)
  248. 2290 BB(IM1,K+1)=ASC(MID$(A$,B1+1,1))
  249. 2300 B1=A2 AND &HF0:B1=B1/16+16*(A3 AND &H3)
  250. 2310 BB(IM1,K+2)=ASC(MID$(A$,B1+1,1))
  251. 2320 B1=(A3 AND &HFC)/4
  252. 2330 BB(IM1,K+3)=ASC(MID$(A$,B1+1,1))  :K=K+4
  253. 2340 NEXT:NEXT
  254. 2350 RETURN
  255. 2500 PRINT "HEADER NOT FOUND IN ";N1$
  256. 2510 PRINT "MAY NOT BE CODED FILE...TRY AGAIN":BEEP
  257. 2520 CLOSE:GOSUB 2560
  258. 2530 GOTO 1050
  259. 2540 PRINT " Checksum errors found in decoding..."
  260. 2550 PRINT " Use with care.."
  261. 2560 PRINT " hit any key to continue..."
  262. 2570 V$=INKEY$:IF V$="" THEN 2570
  263. 2580 RETURN
  264. 2590 ON ERROR GOTO 2670
  265. 2600 OPEN "I",#1,N1$
  266. 2610 CLOSE
  267. 2620 ON ERROR GOTO 2690
  268. 2630 OPEN "I",#1,N2$
  269. 2640 PRINT:PRINT "FILE ";N2$;" EXISTS.. overwrite [y] ? ";
  270. 2650 LINE INPUT V$
  271. 2652 IF V$ ="n" OR V$="N" THEN PRINT "Cancelling..":GOSUB 2560:GOTO 1050
  272. 2660 CLOSE:GOTO 1460
  273. 2670 IF ERR=53 AND ERL=2600 THEN RESUME 2710
  274. 2680 IF ERR=53 AND ERL=1700 THEN RESUME 2710
  275. 2690 IF ERR=53 AND ERL=2630 THEN RESUME 1460
  276. 2700 ON ERROR GOTO 0
  277. 2710 PRINT:PRINT "FILE ";N1$;" NOT FOUND":GOSUB 2560:GOTO 1050
  278. 2720 ON ERROR GOTO 2770
  279. 2730 OPEN "I",#2,N2$
  280. 2740 PRINT:PRINT "FILE ";N2$;" EXISTS.. overwrite [y] ? ";
  281. 2750 LINE INPUT V$
  282. 2752 IF V$ ="n" OR V$="N" THEN PRINT "Cancelling..":GOSUB 2560:GOTO 1050
  283. 2760 GOTO 1770
  284. 2770 IF ERR=53 AND ERL=2730 THEN RESUME 1770
  285. 2800 on error goto 0
  286. 3000 'uudecode module
  287. 3010 'DEFINT A-Z
  288. 3020 'DIM BUF(100)
  289. 3030 REM Trap error opening input file
  290. 3040 ON ERROR GOTO 3590
  291. 3050 CLS:LOCATE 1,11:PRINT "uudecode-module"
  292. 3060 LOCATE 5,11
  293. 3070 PRINT STRING$(40," ")
  294. 3080 LOCATE 5,11
  295. 3090 INPUT "Enter name of input file: ", INFILE$: if infile$="" then 1050
  296. 3100 OPEN INFILE$ FOR INPUT AS #1
  297. 3110 LOCATE 8,10
  298. 3120 PRINT STRING$(40," ")
  299. 3130 REM Trap error opening output file
  300. 3140 ON ERROR GOTO 3630
  301. 3150 LOCATE 8,10
  302. 3160 INPUT "Enter name of output file: ", OUTFILE$
  303. 3170 OPEN "R", #2,OUTFILE$, 1
  304. 3180 FIELD #2, 1 AS N$
  305. 3190 REM Trap error at end of file
  306. 3200 ON ERROR GOTO 3670
  307. 3210 REM Search for header line
  308. 3220 LINE INPUT #1,A$
  309. 3230 IF LEFT$(A$,5) <>"begin" THEN 3220
  310. 3240 LOCATE 11,10
  311. 3250 PRINT "Header = ";A$
  312. 3260 SP = ASC(" ")
  313. 3270 '
  314. 3280 RECNO# = 1
  315. 3290 REM Main loop
  316. 3300 LINE INPUT #1, A$
  317. 3310 P = 0
  318. 3320 BYTES = ASC(LEFT$(A$,1)) - SP
  319. 3330 IF BYTES = 64 THEN BYTES = 0
  320. 3340 IF BYTES = 0 THEN 3550
  321. 3350 COUNT% = INT(BYTES/3+.9): COUNT%=COUNT%*4
  322. 3360 FOR I = 2 TO COUNT% STEP 4
  323. 3370   X1 = ASC(MID$(A$,I,I)) - SP
  324. 3380   IF X1 = 64 THEN X1 = 0
  325. 3390   X2 = ASC(MID$(A$,I+1,I+1)) - SP
  326. 3400   IF X2 = 64 THEN X2 = 0
  327. 3410   X3 = ASC(MID$(A$,I+2,I+2)) - SP
  328. 3420   IF X3 = 64 THEN X3 = 0
  329. 3430   X4 = ASC(MID$(A$,I+3,I+3)) - SP
  330. 3440   IF X4 = 64 THEN X4 = 0
  331. 3450   IF P<BYTES THEN P = P + 1: BUF(P) = (X2\16) + (X1*4)
  332. 3460   IF P<BYTES THEN P = P + 1: BUF(P) = (X3\4) + ((X2 MOD 16) * 16)
  333. 3470   IF P<BYTES THEN P = P + 1: BUF(P) = X4 + ((X3 MOD 4) * 64)
  334. 3480 NEXT I
  335. 3490 FOR I = 1 TO P
  336. 3500   LSET N$ = CHR$(BUF(I))
  337. 3510   PUT #2, RECNO#
  338. 3520   RECNO# = RECNO# + 1
  339. 3530 NEXT I
  340. 3540 GOTO 3300
  341. 3550 goto 1050
  342. 3560 REM
  343. 3570 REM Error trapping routines
  344. 3580 REM
  345. 3590 LOCATE 22,20
  346. 3600 PRINT "Can't open input file"
  347. 3610 GOSUB 3720
  348. 3620 RESUME 3040
  349. 3630 LOCATE 22,20
  350. 3640 PRINT "Can't open output file"
  351. 3650 GOSUB 3720
  352. 3660 RESUME 3110
  353. 3670 LOCATE 22,20
  354. 3680 PRINT "Header line not found"
  355. 3690 GOSUB 3720
  356. 3700 LOCATE 24,1
  357. 3710 goto 1050
  358. 3720 FOR I = 1 TO 30000: NEXT I
  359. 3730 LOCATE 22,20
  360. 3740 PRINT STRING$(30," ")
  361. 3750 RETURN
  362. ==============end of program============
  363. ========test for decoding===========
  364. :UTIL3.2test.doc                                                         FF
  365. :UQWZlMSK5@g1o2f1auFH5@BH5@BH5@BH5HV35hDHLEv2l@BThew1iMv1l@RUO2TUEqDTHqBH22
  366. :qdCNvt5B5@BH5@BH5@BH5@BH5@BH5@BH5@BH5@BH5LT2rIWYnQGHVUf1sev0nAbLnHCH5DSN09
  367. :x1SCJt5B5@BH5@BHTaVZsAB1r8vYrEV05dv151g1iQG2eyFHiyFHMevXr8v1oYF25HTXsevX1F
  368. :5Df0dAr1h8V2lQFHbUFHc8V0peF0eQFHbeWCJXWYrMWZoyFHr@r0fAbPaMwXouFHoIGHTUg184
  369. :b8FHBEv1iMfK5du0uAR0aeGHaqv1oAb1uyFHtaVY5Lw0uIwXeAbYoIW05Tg0dUf15t5BBEv1A9
  370. :iMVX5XUYrAbL57f151f1eEF2eIGHbUG25dF251WZlqFHbUFHsqv0wEBHD8tT5LcKxAB1rUfYA4
  371. :eIg1eQFHf8f15t5Bc8V0peF0eQFHvUf1sev0nyRCJ@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@0B
  372. :@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@00
  373. :00000001FF
  374. ====should be first para of explanation =========
  375.