#11 Article 695 Posted at 1987/12/11 11:08:55 by ｱｶﾙｲ ﾉｳｿﾝ (MAP000) [PRG.X68]
Subject: HC6.BAS (for X68000)
100 /*
110 /* hc6 6bit encoder decoder for msc
120 /* by tam(asc10041) 860620
130 /* modified by y.tokugawa (asc11161) 860623
140 /* version 1.10 by tam (asc10041) 860623
150 /* for basic by calf (asc14245)
160 /* X-basic by BIG-X (pcs12107) 870707
170 /*
180 /* encode:
190 /* >filename[:number]
200 /*
210 /* decode:
220 /* >file.hc6
230 /* end >.
240 error off
250 str defname$,opt$,c$
260 str filename$[50],ofilename$[50],file$[50]
270 str encbuf$[255] : dim char buffer(255)
280 /*
290 int fr=0,dl=0,sum=0
300 offset = &H30
310 defpakl = 56
320 defname$ = "hc6.out"
330 v100 = 100
340 v110 = 110
350 width 96:usage()
360 /*
370 /*func main()
380 /*
390 packetl = defpakl
400 version = v110
410 while 1
420 print ">";
430 linput filename$
440 if filename$ = "" then usage() : continue
450 if left$(filename$,1) = "." then break
460 /*
470 p = instr(1,filename$,":")
480 if p <> 0 then {
490 d = val(mid$(filename$,p+1,3))
500 filename$ = left$(filename$,p-1)
510 if 1 <= d and d <= 63 then packetl = d
520 }
530 p = instr(1,filename$,".")
540 if p = 0 then file$ = filename$:opt$ = "":encode() else {
550 file$ = left$(filename$,p-1)
560 opt$ = mid$(filename$,p+1,3)
570 if opt$ = "hc6" or opt$="HC6" then decode() else encode()
580 }
590 endwhile
600 end
610 /*
620 /* ==========
630 /*
640 func encode()
650 /*
660 print : print "encode: ";filename$;" => ";file$;".HC6"
670 error_f = 0 :fi=fopen(filename$,"r") : if fi<0 then e_open()
680 fo=fopen(file$+".HC6","c") : if fo<0 then e_open()
690 /*
700 if version = v100 then error_f=fputc(chr$(34),fo) else error_f=fputc('#',fo)
710 if error_f<0 then e_writes()
720 if fwrites(filename$,fo)<0 then e_writes()
730 fputc(13,fo):if fputc(10,fo)<0 then e_writes()
740 /*
750 while 1
760 f_read()
770 encbuf$ = ""
780 if dl <> 0 then {
790 sum = 0
800 for i = 1 to dl
810 sum = sum + buffer(i)
820 next
830 /*
840 buffer(dl + 1) = sum mod 256
850 dl = dl +1
860 encd()
870 /*
880 if version <> v100 then {
890 encbuf$ = chr$(fr + offset) + encbuf$
900 fr = fr + 1
910 if fr = 64 then fr = 0
920 } }
930 encbuf$ = chr$(dl + offset) + encbuf$
940 if fwrites(encbuf$,fo)<0 then e_writes()
950 fputc(13,fo):if fputc(10,fo)<0 then e_writes()
960 if dl = 0 then break
970 endwhile
980 fcloseall()
990 endfunc
1000 /*
1010 func f_read()
1020 buffer(0)=0 : dl = 0
1030 while (not feof(fi)) and ( dl < packetl)
1040 dl = dl+1 : buffer(dl) = fgetc(fi)
1050 endwhile
1060 /*
1070 endfunc
1080 /*
1090 func encd()
1100 /*
1110 c=0
1120 for loop = 1 to dl
1130 d = buffer(loop)
1140 switch c
1150 case 0:/* |765432|10xxxx|
1160 encbuf$ = encbuf$ + chr$(d \ 4 + offset)
1170 d1 = (d * 16) and &H30
1180 c = 1
1190 break
1200 case 1:/* |xx7654|3210xx}
1210 encbuf$ = encbuf$ + chr$(d \ 16 + d1 + offset)
1220 d1 = (d * 4) and &H3C
1230 c = 2
1240 break
1250 case 2:/* |xxxx76|543210|
1260 encbuf$ = encbuf$ + chr$(d \ 64 + d1 + offset)
1270 encbuf$ = encbuf$ + chr$((d and &H3F) + offset)
1280 c = 0
1290 endswitch
1300 next
1310 if c <> 0 then encbuf$ = encbuf$ + chr$(d1 + offset)
1320 endfunc
1330 /*
1340 func decode()
1350 /*
1360 print : print "decode: ";filename$;
1370 error_f = 0 :fi=fopen(filename$,"r") : if fi<0 then e_open()
1380 lineno = 1
1390 fr = 0
1400 if freads(encbuf$,fi)<0 then e_reads()
1410 c$ = left$(encbuf$,1)
1420 if c$ = chr$(34) or c$ = "#" then {
1430 if c$ = chr$(34) then version = v100
1440 ofilename$ = mid$(encbuf$,2,50)
1450 if freads(encbuf$,fi)<0 then e_reads()
1460 lineno = lineno + 1
1470 } else ofilename$ = defname$
1480 /*
1490 error_f = 0 :fo=fopen(ofilename$,"c") : if fo<0 then e_open()
1500 print " => ";ofilename$
1510 /*
1520 while(asc(left$(encbuf$,1)) <> offset)
1530 dl = asc(mid$(encbuf$,1,1)) - offset
1540 decd()
1550 if version <> v100 then {
1560 if asc(mid$(encbuf$,2,1)) - offset <> fr then print ofilename$;": frame error in line";lineno : break
1570 fr = fr + 1
1580 if fr = 64 then fr = 0
1590 }
1600 dl = dl - 1
1610 sum = 0
1620 for i = 1 to dl
1630 sum = sum + buffer(i)
1640 next
1650 if buffer(dl+1) <> sum mod 256 then print ofilename$;": checksum error in line";lineno : break
1660 /*
1670 for i= 1 to dl
1680 if fputc(buffer(i),fo) < 0 then e_writes()
1690 next
1700 lineno = lineno + 1
1710 if freads(encbuf$,fi)<0 then e_reads()
1720 endwhile
1730 fcloseall()
1740 endfunc
1750 /*
1760 func decd()
1770 buffer(0)=0
1780 if version = v100 then enc = 2 else enc = 3
1790 /*
1800 c = 0
1810 for loop = 1 to dl
1820 switch c
1830 case 0:/* |765432|10xxxx|
1840 d1 = asc(mid$(encbuf$,enc,1)) - offset
1850 enc = enc + 1
1860 d2 = asc(mid$(encbuf$,enc,1)) - offset
1870 enc = enc + 1
1880 d = (d1 * 4) + ((d2 \ 16) and &H3)
1890 c = 1
1900 break
1910 case 1:/* |xx7654|3210xx|
1920 d1 = asc(mid$(encbuf$,enc,1)) - offset
1930 enc = enc + 1
1940 d = ((d2 * 16) and &HFF) + ((d1 \ 4) and &HF)
1950 c = 2
1960 break
1970 case 2:/* |xxxx76|543210|
1980 d2 = asc(mid$(encbuf$,enc,1)) - offset
1990 enc = enc + 1
2000 d = ((d1 * 64) and &HC0) + d2
2010 c = 0
2020 endswitch
2030 buffer(loop) = d
2040 next
2050 endfunc
2060 /*
2070 func usage()
2080 /*
2090 print "hc6: 6bit file converter version 1.10X"
2100 print " encode:"
2110 print " >filename[:number]":print
2120 print " decode:"
2130 print " >filename.hc6":print
2140 print " end :"
2150 print " >.":print
2160 endfunc
2170 /*
2180 func e_open()
2190 print "*** file open error ***"
2200 abort()
2210 endfunc
2220 func e_writes()
2230 print "*** file write error ***"
2240 abort()
2250 endfunc
2260 func e_reads()
2270 print "*** file read error ***"
2280 abort()
2290 endfunc
2300 func abort()
2310 print "*** program abort."
2320 fcloseall():beep
2330 end
2340 endfunc