home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast.iso
/
decode
/
3_4encod.bas
< prev
next >
Wrap
BASIC Source File
|
1994-03-04
|
12KB
|
375 lines
Date: Fri, 22 Jan 88 09:55:20 EST
From: J Law <PHYJLAW%UOGUELPH.BITNET@CUNYVM.CUNY.EDU>
Subject: Re: Info-IBMPC Digest V7 #3
To: Gregory Hicks COMFLEACTS <hicks@walker-emh.arpa>
Util3- program by J Law, Physics, UOGUELPH, 1986
Current Version 2.2 1987
This program is written in Microsoft Basic and should be compiled by
version 2 of Bascom or Turbo Basic. You may also run the source form under
Basica Ver 2 or greater but it will be slow! DOS 3.x preferred for
compiled version.
Objectives: Util3 allows you to unload a binary file or a document
file that has control characters in, eg wordstar or wordperfect files,
into an ASCII file which you can the upload to a mainframe and shipped
via NETNORTH/BITNET etc to your colleagues, who would then use their
version of UTIL3 to decode the file back to its original form.
Encoding/Decoding: I use a 4 byte for 3 byte encode, so that
every 3 bytes are expanded into 4 bytes, each byte corresponds to the
6 bits from the original 3x8=24 bits.
byte 3 byte 2 byte 1
xxxxxxxx yyyyyyyy zzzzzzzz
_| || ||_ || |__
/ |\ \ \ |\ \
00xxxxxx 00xxyyyy 00yyyyzz 00zzzzzz
byte 4 byte 3 byte 2 byte 1
These 4 bytes have values of 0 to 2^6-1=63. The mapping I use is:
defined in line 1030 of the program
mapping @ABCDEFGHIJKLMNOPQRSTUVWXYZ012345abcdefghijklmnopqrstuvwxyz6789?
char# 00000000001.............. ... 66
01234567890.............. ... 23
Decoding is the inverse. However to provide some error testing, the file
written out is as follows:
id name 12 chars byte in hex form
| | | \ \
:UTIL3.2util3.exe FF
:MiEyA7D@@@5@@@@@??O@@@H@@@5jA@@@1@@@@@@@@@@UUIePOAbPAMURC8rPoAW3revYhQGH31
| / /
\ coded data 2 hex values representing
byte value checksum for the
coded data modulo Hex100
ie sum up all bytes mod H100, then last byte is
Hex100 - sum
last line :00000001FF simply for identification
Comments:
Although this program can be used on its own, note that your file
will get at least 30% larger. It is best used with a file squeezer program
like arc, pkarc or sq.exe all of which are in the shareware
arena. If you use arc to compress a program file for example, then util3
will at most re expand it to its original size, but you can then send this
file thro a mainframe as it is ASCII.
When run, the following screen should appear:
====================================================
UTIL3 - PROGRAM VER 2.2
J LAW PHYSICS UoGuelph October 1987
Ascii coding of files for electronic transfer
using a 3 byte for 4 byte coding
(1) convert file.??? TO file.3T4
(2) convert file.3T4 TO file.???
(3) uudecode file
(0) EXIT
CHOOSE A NUMBER:
===================================================
Choice 1 will convert anyfile.ext to anyfile.3t4.
Choice 2 will convert anyfile.3t4 back to filename.ext.
Choice 3 will uudecode files from Simtel20.arpa, which are uuencoded.
This is placed in the public domain for all to use & enjoy.
Any comments or modifications to speed up program are welcome:
Dr J. Law
Physics Dept
University of Guelph
Guelph On Canada.
N1G 2W1
Bitnet/NetNorth: Phyjlaw @ Uoguelph
===========Program util3.bas============================
1000 DEFINT A-Z
1010 DIM A(30,80),BB(30,80),buf(1000)
1030 A2$="@ABCDEFGHIJKLMNOPQRSTUVWXYZ012345abcdefghijklmnopqrstuvwxyz6789?"
1040 A$=A2$'SETUP FOR VERSION 2
1050 LOCATE 1,1,1 :B1$=""
1060 CLS:CLOSE:A$=A2$ :i19=71:i15=54
1070 PRINT " UTIL3 - PROGRAM VER 2.2 "
1080 PRINT " J LAW PHYSICS UoGuelph October 1987 "
1090 PRINT " Ascii coding of files for electronic transfer "
1100 PRINT " using a 3 byte for 4 byte coding "
1110 PRINT " "
1120 PRINT "(1) convert file.??? TO file.3T4 "
1130 PRINT "(2) convert file.3T4 TO file.??? "
1140 PRINT
1145 PRINT "(3) uudecode file"
1147 PRINT
1150 PRINT "(0) EXIT"
1160 PRINT " "
1170 PRINT " "
1180 LINE INPUT "CHOOSE A NUMBER:";VA$:IF VA$="" THEN 1050
1190 PRINT " " :VA=VAL(VA$)
1200 IF VA=0 THEN STOP
1210 IF VA>3 THEN 1050
1215 IF VA=3 THEN 3000 ' uudecode
1220 LINE INPUT "INPUT FILENAME.EXT : ";N$
1230 'IF VA=2 THEN LINE INPUT "OUTPUT FILENAME.EXT : ";N2$
1240 GOSUB 2140
1250 IF VA=1 THEN 2590 ' CONVERT TO 3T4
1260 IF VA=2 THEN 1680 ' 3T4 TO ???
1270 '
1280 'WRITE FILE :..20..CHARS..
1290 GOSUB 2210 'UNLOAD 3 TO 4
1300 FOR IM1=0 TO IM1X
1310 V$="" :CHKSUM=0
1320 FOR J=0 TO i19
1330 AIJ=BB(IM1,J)
1340 V1$=CHR$(AIJ):CHKSUM=(CHKSUM+AIJ) MOD &H100
1350 '
1360 V$=V$+V1$
1370 NEXT J
1380 CK=(&H100-CHKSUM)
1390 V3$=HEX$(CK):IF LEN(V3$)=1 THEN V3$="0"+V3$
1400 IF LEN(V3$)>=3 THEN V3$=RIGHT$(V3$,2)
1410 PRINT #2,":"+V$+V3$
1420 '
1430 NEXT IM1
1440 RETURN
1460 OPEN "R",#1,N1$,i15
1470 FIELD #1,i15 AS B$
1475 mx=lof(1)/i15
1480 OPEN "O",#2,N2$
1490 TB=0:IM1X=0
1500 GOSUB 2100 'WRITE HEADER
1502 for ibyte=1 to mx+1
1510 GOSUB 1570 'get com file
1530 GOSUB 1280 'write hex file
1540 next ibyte
1550 PRINT #2,":00000001FF" :CLOSE
1560 GOTO 1050 'CLOSE EXIT
1570 'READ COM OR EXE FILE
1590 GET #1:B1$=B$
1600 I1=0:J1=0:IM1X=0
1610 N=LEN(B1$):I=1
1620 AA$=MID$(B1$,I,1):I=I+1
1630 A(I1,J1)=ASC(AA$)
1640 J1=J1+1:IF J1<i15 THEN 1660
1650 J1=0 :IM1X=I1:I1=I1+1
1660 IF I<=N THEN 1620
1670 RETURN
1675 '
1680 CHKERR=0 :IH=0
1690 ON ERROR GOTO 2670
1700 OPEN "I",#1,N1$
1710 LINE INPUT #1,V$
1720 TC=INSTR(V$,":UTIL3"):IF TC<>0 THEN 1750
1730 IF IH <= 10 THEN IH=IH+1:GOTO 1710 ELSE GOTO 2500
1750 N2$=MID$(V$,9,12):PRINT "DECODING ";N2$
1755 if len(v$)>30 then i15=54:i19=71 ELSE I15=15:I19=19
1760 GOTO 2720
1770 CLOSE #2 : recno#=1
1780 OPEN "R",#2,N2$,i15
1782 field #2, i15 as n$
1790 GOSUB 1880 'read&write
1800 IF TB<>0 THEN 1830
1810 ' GOSUB 2030 write
1820 GOTO 1790
1830 CLOSE
1840 IF CHKERR<>0 THEN GOSUB 2540
1850 GOTO 1050
1860 '
1870 'read in hex file
1880 '
1890 IF EOF(1) THEN RETURN
1900 LINE INPUT #1,V$
1902 tb=instr(v$,":"):if tb=0 then 1890
1910 TB=INSTR(V$,":00000001FF"):IF TB<>0 THEN RETURN
1920 CHKSUM=0
1930 FOR J=0 TO i19
1940 BB(0,J)=ASC(MID$(V$,2+J,1))
1950 CHKSUM=(CHKSUM+BB(0,J)) MOD &H100
1960 NEXT J
1970 CK=(&H100-CHKSUM)
1980 V3$=HEX$(CK):IF LEN(V3$)=1 THEN V3$="0"+V3$
1990 IF LEN(V3$)>=3 THEN V3$=RIGHT$(V3$,2)
2000 IF V3$<>RIGHT$(V$,2) THEN CHKERR=CHKERR+1
2360 ' 4 TO 3 MAPPING
2370 K=0
2380 FOR J=0 TO i19 STEP 4
2390 A1=BB(0,J):A2=BB(0,J+1):A3=BB(0,J+2):A4=BB(0,J+3)
2400 A1=INSTR(A$,CHR$(A1))-1
2410 A2=INSTR(A$,CHR$(A2))-1
2420 A3=INSTR(A$,CHR$(A3))-1
2430 A4=INSTR(A$,CHR$(A4))-1
2440 B1=(A2 AND &H03)*64+A1:A(0,K)=B1
2450 B1=(A2 AND &H3C)/4+(A3 AND &H0F)*16 :A(0,K+1)=B1
2460 B1=(A3 AND &H30)/16+(A4 AND &H3F)*4 :A(0,K+2)=B1
2470 K=K+3
2480 NEXT
2030 ' print to com file
2040 an$=""
2050 FOR J=0 TO i15-1
2060 an$=an$+chr$(A(0,J))
2070 NEXT
2075 lset n$=an$
2080 Put #2,recno#:recno#=recno#+1
2090 RETURN
2100 'HEADER WRITTEN
2110 B2$=":UTIL3.2"+N1$+SPACE$(i19-6-LEN(N1$))+"FF"
2120 PRINT #2,B2$
2130 RETURN
2140 I=INSTR(N$,"."):IF I=0 THEN 2180
2150 IF VA=1 OR VA=4 THEN N1$=N$:N2$=MID$(N$,1,I)+"3T4"
2160 IF VA=2 THEN N1$=MID$(N$,1,I)+"3T4"
2170 RETURN
2180 IF VA=1 OR VA=4 THEN N1$=N$:N2$=N$+".3T4"
2190 IF VA=2 THEN N1$=N$+".3T4"
2200 RETURN
2210 ' 3 TO 4 MAPPING
2220 FOR IM1= 0 TO IM1X
2230 K=0
2240 FOR J=0 TO i15-1 STEP 3
2250 A1=A(IM1,J):A2=A(IM1,J+1):A3=A(IM1,J+2)
2260 B1= A1 AND 63
2270 BB(IM1,K)=ASC(MID$(A$,B1+1,1))
2280 B1= A1 AND &HC0:B1=B1/64+4*(A2 AND &HF)
2290 BB(IM1,K+1)=ASC(MID$(A$,B1+1,1))
2300 B1=A2 AND &HF0:B1=B1/16+16*(A3 AND &H3)
2310 BB(IM1,K+2)=ASC(MID$(A$,B1+1,1))
2320 B1=(A3 AND &HFC)/4
2330 BB(IM1,K+3)=ASC(MID$(A$,B1+1,1)) :K=K+4
2340 NEXT:NEXT
2350 RETURN
2500 PRINT "HEADER NOT FOUND IN ";N1$
2510 PRINT "MAY NOT BE CODED FILE...TRY AGAIN":BEEP
2520 CLOSE:GOSUB 2560
2530 GOTO 1050
2540 PRINT " Checksum errors found in decoding..."
2550 PRINT " Use with care.."
2560 PRINT " hit any key to continue..."
2570 V$=INKEY$:IF V$="" THEN 2570
2580 RETURN
2590 ON ERROR GOTO 2670
2600 OPEN "I",#1,N1$
2610 CLOSE
2620 ON ERROR GOTO 2690
2630 OPEN "I",#1,N2$
2640 PRINT:PRINT "FILE ";N2$;" EXISTS.. overwrite [y] ? ";
2650 LINE INPUT V$
2652 IF V$ ="n" OR V$="N" THEN PRINT "Cancelling..":GOSUB 2560:GOTO 1050
2660 CLOSE:GOTO 1460
2670 IF ERR=53 AND ERL=2600 THEN RESUME 2710
2680 IF ERR=53 AND ERL=1700 THEN RESUME 2710
2690 IF ERR=53 AND ERL=2630 THEN RESUME 1460
2700 ON ERROR GOTO 0
2710 PRINT:PRINT "FILE ";N1$;" NOT FOUND":GOSUB 2560:GOTO 1050
2720 ON ERROR GOTO 2770
2730 OPEN "I",#2,N2$
2740 PRINT:PRINT "FILE ";N2$;" EXISTS.. overwrite [y] ? ";
2750 LINE INPUT V$
2752 IF V$ ="n" OR V$="N" THEN PRINT "Cancelling..":GOSUB 2560:GOTO 1050
2760 GOTO 1770
2770 IF ERR=53 AND ERL=2730 THEN RESUME 1770
2800 on error goto 0
3000 'uudecode module
3010 'DEFINT A-Z
3020 'DIM BUF(100)
3030 REM Trap error opening input file
3040 ON ERROR GOTO 3590
3050 CLS:LOCATE 1,11:PRINT "uudecode-module"
3060 LOCATE 5,11
3070 PRINT STRING$(40," ")
3080 LOCATE 5,11
3090 INPUT "Enter name of input file: ", INFILE$: if infile$="" then 1050
3100 OPEN INFILE$ FOR INPUT AS #1
3110 LOCATE 8,10
3120 PRINT STRING$(40," ")
3130 REM Trap error opening output file
3140 ON ERROR GOTO 3630
3150 LOCATE 8,10
3160 INPUT "Enter name of output file: ", OUTFILE$
3170 OPEN "R", #2,OUTFILE$, 1
3180 FIELD #2, 1 AS N$
3190 REM Trap error at end of file
3200 ON ERROR GOTO 3670
3210 REM Search for header line
3220 LINE INPUT #1,A$
3230 IF LEFT$(A$,5) <>"begin" THEN 3220
3240 LOCATE 11,10
3250 PRINT "Header = ";A$
3260 SP = ASC(" ")
3270 '
3280 RECNO# = 1
3290 REM Main loop
3300 LINE INPUT #1, A$
3310 P = 0
3320 BYTES = ASC(LEFT$(A$,1)) - SP
3330 IF BYTES = 64 THEN BYTES = 0
3340 IF BYTES = 0 THEN 3550
3350 COUNT% = INT(BYTES/3+.9): COUNT%=COUNT%*4
3360 FOR I = 2 TO COUNT% STEP 4
3370 X1 = ASC(MID$(A$,I,I)) - SP
3380 IF X1 = 64 THEN X1 = 0
3390 X2 = ASC(MID$(A$,I+1,I+1)) - SP
3400 IF X2 = 64 THEN X2 = 0
3410 X3 = ASC(MID$(A$,I+2,I+2)) - SP
3420 IF X3 = 64 THEN X3 = 0
3430 X4 = ASC(MID$(A$,I+3,I+3)) - SP
3440 IF X4 = 64 THEN X4 = 0
3450 IF P<BYTES THEN P = P + 1: BUF(P) = (X2\16) + (X1*4)
3460 IF P<BYTES THEN P = P + 1: BUF(P) = (X3\4) + ((X2 MOD 16) * 16)
3470 IF P<BYTES THEN P = P + 1: BUF(P) = X4 + ((X3 MOD 4) * 64)
3480 NEXT I
3490 FOR I = 1 TO P
3500 LSET N$ = CHR$(BUF(I))
3510 PUT #2, RECNO#
3520 RECNO# = RECNO# + 1
3530 NEXT I
3540 GOTO 3300
3550 goto 1050
3560 REM
3570 REM Error trapping routines
3580 REM
3590 LOCATE 22,20
3600 PRINT "Can't open input file"
3610 GOSUB 3720
3620 RESUME 3040
3630 LOCATE 22,20
3640 PRINT "Can't open output file"
3650 GOSUB 3720
3660 RESUME 3110
3670 LOCATE 22,20
3680 PRINT "Header line not found"
3690 GOSUB 3720
3700 LOCATE 24,1
3710 goto 1050
3720 FOR I = 1 TO 30000: NEXT I
3730 LOCATE 22,20
3740 PRINT STRING$(30," ")
3750 RETURN
==============end of program============
========test for decoding===========
:UTIL3.2test.doc FF
:UQWZlMSK5@g1o2f1auFH5@BH5@BH5@BH5HV35hDHLEv2l@BThew1iMv1l@RUO2TUEqDTHqBH22
:qdCNvt5B5@BH5@BH5@BH5@BH5@BH5@BH5@BH5@BH5LT2rIWYnQGHVUf1sev0nAbLnHCH5DSN09
:x1SCJt5B5@BH5@BHTaVZsAB1r8vYrEV05dv151g1iQG2eyFHiyFHMevXr8v1oYF25HTXsevX1F
:5Df0dAr1h8V2lQFHbUFHc8V0peF0eQFHbeWCJXWYrMWZoyFHr@r0fAbPaMwXouFHoIGHTUg184
:b8FHBEv1iMfK5du0uAR0aeGHaqv1oAb1uyFHtaVY5Lw0uIwXeAbYoIW05Tg0dUf15t5BBEv1A9
:iMVX5XUYrAbL57f151f1eEF2eIGHbUG25dF251WZlqFHbUFHsqv0wEBHD8tT5LcKxAB1rUfYA4
:eIg1eQFHf8f15t5Bc8V0peF0eQFHvUf1sev0nyRCJ@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@0B
:@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@00
:00000001FF
====should be first para of explanation =========