10 Rem MF_CODE.BXL -- Mail File Encoder/Decoder
20 Rem By: Robert S. Ely -- JACS 93Jan04
30 Rem drjolts@phsbbs.princeton.nj.us internet
40 Rem Dr. Jolts@JACS on the Citadel network
50 Rem R.ELY1 on GEnie
60 Rem JACS is the Jersey Atari Computer Society
70 Rem PO Box 710 Clementon,NJ 08021
80 Rem JACS BBS (609) 346-1224
90 Rem Running Fnordadel v.3.13 300-14400 BPS
100 Fast :Clr :Dim Fn$(4,64),Ibuff$(20),Obuff$(40),Text$(80),Parts$(4),Blks$(4),Temp$(40)
110 Lof=Flen:Clin=16:Zero=0:Egt=8:Eol=155
120 Mxblk=3328:Let One=1:Two=2:Three=3:Four=4:Tt=33:Mo=-1
130 Graphics 18:Position 5,0:? #6;"MAIL FILE":Position 2,1:? #6;"ENCODER/DECODER"
140 Position 0,3:? #6;"вщє тпветф емщ­КБГУ";
150 Position 0,6:? #6;"please select:"
160 Position 0,8:? #6;"0) MF encode a file"
170 Position 0,9:? #6;"1) MF decode a file"
180 Close #1:Open #One,Four,Zero,"K:":Get #One,Cnt:Inc=Cnt-48:Close #One
190 If Inc<0 Or Inc>1 Then 180
200 If Inc:Goto 910:Else :Goto 210:Endif 
210 Input "}Enter УПХТГЕ drive number: ",Sdn
220 Input "}Enter ДЕУФЙОБФЙПО drive number: ",Ddn
230 Input "}Enter УПХТГЕ path>filename.ext:",Fn$(One;):Gosub 770
240 Fn$(Three;)="D",Str$(Sdn),":",Fn$(One;)
250 For Inc=Len(Fn$(One;)) To One Step Mo
260   If Fn$(One;Inc,Inc)=">" Or Fn$(One;Inc,Inc)="\":Pop :Goto 280
270   Else :Next Inc:Goto 280:Endif 
280 Temp$=Fn$(One;Inc+One)
290 Input "}Enter ДЕУФ® path>(W/O filename.ext):",Fn$(Four;):Gosub 770
300 Fn$(Four;)="D",Str$(Ddn),":",Fn$(One;)
310 For Inc=Len(Temp$) To One Step Mo
320   If Temp$(Inc,Inc)=".":Pop :Goto 330:Else :Next Inc:Endif 
330 Fn$(Four;)="D",Str$(Ddn),":",Temp$(One,Inc-One),".MF1"
340 Close #One:Close #Two:Open #One,Four,Zero,Fn$(Three;)
350 Xio 39,#One,Zero,Zero,Fn$(Three;):Flen=Dpeek(860)+Peek(862)*65536:Close #1:Open #One,Four,Zero,Fn$(Three;):Lof=Flen
360 If Flen/Mxblk>Int(Flen/Mxblk):Blks=Int(Flen/Mxblk)+1:Else :Blks=Flen/Mxblk:Endif 
370 Blks$="0000":Blks$=Left$(Blks$,Len(Blks$)-Len(Str$(Blks))),Str$(Blks):Mxlin=Mxblk/Clin
380 If Lof>Mxblk:Rlin=Mxlin:Goto 410
390 Else :If Lof/Clin>Int(Lof/Clin):Rlin=Int(Lof/Clin)+1:Goto 410
400   Else :Rlin=Int(Lof/Clin):Endif :Endif 
410 Lof=Lof-Mxblk
420 Rem ENCODER
430 For Pts=One To Blks
440   Fn$(Four;Len(Fn$(Four;)),Len(Fn$(Four;)))=Str$(Pts)
450   Parts$="0000":Parts$=Left$(Parts$,Len(Parts$)-Len(Str$(Pts))),Str$(Pts)
460   Graphics 18:Position 5,0:? #6;"MAIL FILE":Position 6,1:? #6;"ENCODER"
470   Position 0,3:? #6;"вщє тпветф емщ­КБГУ";
480   Position 6,5:? #6;"block #":Position 4,6:? #6;Parts$;" of ";Blks$
490   Close #Two:Open #Two,Egt,Zero,Fn$(Four;):Gosub 710
500   For Line=One To Rlin:Obuff$=" ":Ibuff$="                "
510     Trap 550:Bget #One,Adr(Ibuff$),Clin
520     Line$="000":Rlin$="000"
530     Line$=Left$(Line$,Len(Line$)-Len(Str$(Line))),Str$(Line)
540     Rlin$=Left$(Rlin$,Len(Rlin$)-Len(Str$(Rlin))),Str$(Rlin)
550     Position 7,7:? #6;"line #":Position 5,8:? #6;Line$;" of ";Rlin$
560     For Inc=One To Clin
570       Obuff$=Obuff$,Right$(Hex$(Asc(Ibuff$(Inc,Inc))),Two):Next Inc
580     Cksm=0:For Cnt=2 To 33:Cksm=Cksm+Asc(Obuff$(Cnt,Cnt)):Next Cnt
590     Chksum=Int(Cksm/32)
600     Obuff$=Obuff$," ",Right$(Hex$(Chksum),2),Chr$(Eol)
610     Bput #Two,Adr(Obuff$),Tt+Four:Obuff$="":Ibuff$="":Poke 752,One
620     If Err(0)=136:Goto 630:Else :Next Line:Endif 
630   If Pts=Blks:? #Two;" end":Goto 690:Else :? #Two;" cont ";Pts+One:Endif 
640   If Lof>Mxblk:Rlin=Mxlin:Goto 670
650   Else :If Lof/Clin>Int(Lof/Clin):Rlin=Int(Lof/Clin)+1:Goto 670
660     Else :Rlin=Int(Lof/Clin):Endif :Endif 
670   Lof=Lof-Mxblk
680 Next Pts
690 Poke 752,Zero:Close #One:Close #Two:End 
700 Rem HEADER OUTPUT
710 ? #Two;Chr$(Eol):? #Two;Chr$(Eol):? #Two;" >MFE< "
720 ? #Two;" ";Temp$
730 ? #Two;" ";Flen;" Total file bytes"
740 ? #Two;" ";Parts$;" of ";Blks$;" Blocks"
750 ? #Two;" ";Rlin;" Lines this block"
760 Return 
770 Rem SET FILENAME TO ALL CAPS
780 For Inc=One To Len(Fn$(One;))
790   If Asc(Fn$(One;Inc,Inc))>=48 And Asc(Fn$(One;Inc,Inc))<=57 Then Goto 890
800   If Asc(Fn$(One;Inc,Inc))=46 Then Goto 890
810   If Asc(Fn$(One;Inc,Inc))>=65 And Asc(Fn$(One;Inc,Inc))<=90 Then Goto 890
820   If Asc(Fn$(One;Inc,Inc))=62 Or Asc(Fn$(One;Inc,Inc))=92 Then Goto 890
830   If Asc(Fn$(One;Inc,Inc))=190 Or Asc(Fn$(One;Inc,Inc))=220 Then Fn$(One;Inc,Inc)=Chr$(Asc(Fn$(One;Inc,Inc))-128)
840   If Asc(Fn$(One;Inc,Inc))=174 Then Fn$(One;Inc,Inc)=Chr$(Asc(Fn$(One;Inc,Inc))-128)
850   If Asc(Fn$(One;Inc,Inc))>=176 And Asc(Fn$(One;Inc,Inc))<=185 Then Fn$(One;Inc,Inc)=Chr$(Asc(Fn$(One;Inc,Inc))-128)
860   If Asc(Fn$(One;Inc,Inc))>=97 And Asc(Fn$(One;Inc,Inc))<=122 Then Fn$(One;Inc,Inc)=Chr$(Asc(Fn$(One;Inc,Inc))-(Tt-One))
870   If Asc(Fn$(One;Inc,Inc))>=193 And Asc(Fn$(One;Inc,Inc))<=218 Then Fn$(One;Inc,Inc)=Chr$(Asc(Fn$(One;Inc,Inc))-128)
880   If Asc(Fn$(One;Inc,Inc))>=225 And Asc(Fn$(One;Inc,Inc))<=250 Then Fn$(One;Inc,Inc)=Chr$(Asc(Fn$(One;Inc,Inc))-160)
890 Next Inc:Return 
900 Rem Mail File Decoder
910 Input "}Enter УПХТГЕ drive number: ",Sdn
920 Input "}Enter ДЕУФЙОБФЙПО drive number: ",Ddn
930 Input "}Enter УПХТГЕ path>filename.ext:",Fn$(One;):Gosub 770
940 Fn$(Three;)="D",Str$(Sdn),":",Fn$(One;)
950 Input "}Enter ДЕУФ® path>(W/O filename.ext):",Fn$(One;)
960 If Fn$(One;)="" Then Path$="":Goto 980
970 Gosub 770:Path$=Fn$(One;):Fn$(Four;)="D",Str$(Ddn),":",Path$
980 Close #One:Open #One,Four,Zero,Fn$(Three;):Blks=1:Goto 1170
990 Graphics 18:Position 7,0:? #6;"READING!"
1000 Trap 1030:Input #One;Text$:? #6;".";
1010 If Text$="" Or Len(Text$)<6 Then 1000
1020 If Text$(2,6)=">MFE<":Return :Else :Goto 1000:Endif 
1030 If Err(0)=136:Goto 1040:Else :Goto 990:Endif 
1040 Graphics 0:? "}эSorry! No MFE files found!":Goto 690
1050 Trap 40000:Input #One;Fn$(One;)
1060 Fn$(Four;)="D",Str$(Ddn),":",Path$,Fn$(One;Two,Len(Fn$(One;)))
1070 Input #One;Text$
1080 For Inc=Two To Egt
1090   If Text$(Inc,Inc)=" ":Flen=Val(Text$(Two,Inc-One)):Goto 1110
1100   Else :Next Inc:Endif 
1110 Input #One;Text$:Parts$=Text$(2,5):Cnt=Val(Text$):Blks$=Text$(10,13):Blks=Val(Blks$)
1120 Input #One;Text$
1130 For Inc=Two To Two+Four
1140   If Text$(Inc,Inc)=" ":Rlin=Val(Text$(2,Inc-One)):Return 
1150   Else :Next Inc:Return :Endif 
1160 Rem DECODE DATA
1170 Pts=1
1180 Gosub 990:Gosub 1050:Line=Zero
1190 Close #Two:Open #Two,Egt+One,Zero,Fn$(Four;)
1200 Graphics 18:Position 5,0:? #6;"MAIL FILE":Position 6,1:? #6;"DECODER"
1210 Position 0,3:? #6;"вщє тпветф емщ­КБГУ";
1220 Position 6,5:? #6;"block #":Position 4,6:? #6;Parts$;" of ";Blks$
1230 For Line=One To Rlin
1240   Line$="000":Rlin$="000"
1250   Line$=Left$(Line$,Len(Line$)-Len(Str$(Line))),Str$(Line)
1260   Rlin$=Left$(Rlin$,Len(Rlin$)-Len(Str$(Rlin))),Str$(Rlin)
1270   Position 7,7:? #6;"line #":Position 5,8:? #6;Line$;" of ";Rlin$
1280   Trap 40000:Input #One;Text$:Temp$="$",Right$(Text$,2):Cnt=Val(Temp$)
1290   Cksm=0:For Inc=2 To 33:Cksm=Cksm+Asc(Text$(Inc,Inc)):Next Inc
1300   Chksum=Int(Cksm/32)
1310   If Chksum<>Cnt Then 1420
1320   For Inc=Two To Clin*Two Step Two
1330     Temp$="$",Text$(Inc,Inc+One):Ibuff$=Ibuff$,Chr$(Val(Temp$)):Temp$=""
1340   Next Inc
1350   ? #Two;Ibuff$;:Ibuff$=""
1360 Next Line
1370 Pts=Pts+One:If Pts=Blks+One:Goto 1400:Goto 1180:Endif 
1380 If Pts=Blks+One:Goto 1400:Else :Goto 1180:Endif 
1390 Else :Goto 1180:Endif 
1400 Graphics 0:? "BASIC XL":? "is ";:Close #One:Close #Two:End 
1410 Rem CHECKSUM ERROR
1420 Position 0,8:? #6;"CHECKSUM ERROR"
1430 For Inc=1 To 1000:Next Inc
1440 Goto 690