[comp.sys.acorn] Binary Transfer part

atkinsd@sol.cc.deakin.OZ.AU (Damon Atkins,Archimedes Services,0000,1111) (01/22/91)

Part 2 of 3

     This is the second programme which  un-encode's

   10 REM > TextToFile
   20 REM Created By Damon Atkins  Copywrite (C) 15/1/91
   30 REM Nomad International Software.
   40 REM This Software is free and may be freely copied
   50 REM under the condition it is not altered in any way
   60 REM and that no price is charged for it.
   70 REM Mail : nomad@cc.deakin.OZ.AU or datkins@cc.deakin.OZ.AU
   80 REM        6 Woodlands Drive,Ocean Grove 3226,Victoria,Australia.
   90 REM Current Status : Student & Staff member at Deakin University
  100 REM                  Not an owner of an Archimedes or any other computer.
  110 REM                  But owner of the RISC OS Programmer's Ref. Manual
  120 REM Wish List : Archimedes A260, and the Uni. to by some Archimedes.
  130 REM Disclaimer : All views are my own and may not represent views
  140 REM of people associated with me. I do not accept any responsibility
  150 REM whatsoever for damage to hardware or software or data
  160 REM as a result of using this software.
  170 :
  180 DIM argument$(3),Buffer% 256,writeBuffer% 80
  190 MaxArg%=2
  200 PROCargument("TextToFile")
  210 IF argument$(0)="" OR argument$(0)="?" THEN
  220   PROChelp(argument$(0))
  230 ELSE
  240   IF argument$(1)<>"" THEN
  250     IF LEN(argument$(1))>2 THEN
  260       PRINT "Error hex number to large. Eg. 0A or 0D ...." : END
  270     ELSE
  280       endline$=CHR$(EVAL("&"+argument$(1)))
  290     ENDIF
  300   ELSE
  310     endline$=CHR$(&A)
  320   ENDIF
  330   PROCtexttodata(argument$(0),endline$)
  340 ENDIF
  350 END
  360 :
  370 DEF PROCargument(commandName$)
  380 LOCAL commline%,addr%,letter%,found%,nextarg%,arg%
  390 argument$()="          "
  400 argument$()=""
  410 FOR letter%=1 TO LEN(commandName$)
  420   MID$(commandName$,letter%,1)=CHR$(ASC(MID$(commandName$,letter%,1)) OR 32)
  430 NEXT letter%
  440 SYS "OS_GetEnv" TO commline%
  450 addr%=commline%
  460 WHILE ?addr%>31
  470   addr%+=1
  480 ENDWHILE
  490 ?addr%=13
  500 addr%=commline%
  510 WHILE ?addr%>31 AND NOT(found%)
  520   addr%+=1
  530   letter%=1
  540   WHILE CHR$(addr%?(letter%-1) OR 32)=MID$(commandName$,letter%,1)
  550     letter%+=1
  560   ENDWHILE
  570   found%=(letter%-1=LEN(commandName$))
  580 ENDWHILE
  590 IF NOT(found%) THEN PRINT "Rename file back to orginal name - ";commandName$:END
  600 nextarg%=INSTR($addr%," ")
  610 arg%=0
  620 WHILE nextarg%<>0 AND arg%<MaxArg%
  630   addr%+=nextarg%
  640   nextarg%=INSTR($addr%," ")
  650   argument$(arg%)=LEFT$($addr%,nextarg%-1)
  660   IF argument$(arg%)<>"" THEN arg%+=1
  670 ENDWHILE
  680 ENDPROC
  690 :
  700 DEF PROCtexttodata(input$,endofline$)
  710 LOCAL objectType%,textlength%,chanInput%,chanOutput%,fileName$
  720 LOCAL loadAddr%,execAddr%,length%,attrib%
  730 LOCAL marker%,line%,chksum%,bytes%,write%,key%
  740 LOCAL linechk%,chksumchk%
  750 SYS "OS_File",13,input$,,,"" TO objectType%,,,,textlength%
  760 IF objectType%=0 THEN PRINT input$;" Not Found" : END
  770 chanInput%=OPENIN(input$)
  780 IF FNfindInFile(chanInput%,"%Begin ","")<>0 THEN
  790   SYS "OS_GBPB",4,chanInput%,Buffer%,57
  800   Buffer%?57=&D
  810   fileName$=MID$($Buffer%,8,INSTR($(Buffer%+8)," "))
  820   loadAddr%=EVAL("&"+MID$($Buffer%,23,8))
  830   execAddr%=EVAL("&"+MID$($Buffer%,32,8))
  840   length%=EVAL("&"+MID$($Buffer%,41,8))
  850   attrib%=EVAL("&"+MID$($Buffer%,50,8))
  860   chanOutput%=OPENOUT(fileName$)
  870   marker%=0 : line%=0 : chksum%=0
  880   write%=57 : bytes%=0
  890   PRINT STRING$(length% DIV 1026,"/");STRING$(length% DIV 1026,CHR$(8));
  900   key%=FNfindInFile(chanInput%,"%End ",endofline$+STR$(marker%))
  910   WHILE NOT(EOF#chanInput%) AND (key%=2)
  920     D%=BGET#chanInput%
  930     SYS "OS_GBPB",4,chanInput%,Buffer%,78 TO ,,,NotTrans%
  940     Buffer%?78=&D
  950     FOR q%=1 TO 76
  960       Buffer%?q%-=59
  970       chksum%=(chksum%+q%*13+Buffer%?q%) MOD &7FFFFFFF
  980     NEXT q%
  990     PROCconvertBlock6to8(Buffer%+1,writeBuffer%,76)
 1000     bytes%+=write%
 1010     IF bytes%>length% THEN write%=length% MOD write%
 1020     SYS "OS_GBPB",2,chanOutput%,writeBuffer%,write%
 1030     line%+=1
 1040     IF line% MOD 18=0 THEN PRINT ;"%";
 1050     marker%+=1
 1060     IF $(Buffer%+77)<>STR$(marker%) THEN PRINT"Error incorrect line":END
 1070     marker%=(marker%+1) MOD 10
 1080     key%=FNfindInFile(chanInput%,"%End ",endofline$+STR$(marker%))
 1090   ENDWHILE
 1100   SYS "OS_GBPB",4,chanInput%,Buffer%,22
 1110   Buffer%?22=&D
 1120   linechk%=EVAL("&"+MID$($Buffer%,6,8))
 1130   chksumchk%=EVAL("&"+MID$($Buffer%,15,8))
 1140   IF linechk%<>line% THEN PRINT "Error incorect number of lines"
 1150   IF chksumchk%<>chksum% THEN PRINT "Error check sum does not match"
 1160   CLOSE #chanOutput%
 1170   SYS "OS_File",1,fileName$,loadAddr%,execAddr%,,attrib%
 1180 ELSE
 1190   PRINT "Could not find in file %Begin"
 1200 ENDIF
 1210 CLOSE #chanInput%
 1220 PRINT
 1230 ENDPROC
 1240 :
 1250 DEF PROCconvertBlock6to8(input%,output%,size%)
 1260 LOCAL n%,n2%
 1270 IF (size% MOD 4)<>0 THEN PRINT "Error not a multipal of 32 bits" : END
 1280 FOR n%=0 TO size%-1 STEP 4
 1290   PROCconvert8to6(input%+n%,output%+n2%)
 1300   n2%+=3
 1310 NEXT n%
 1320 ENDPROC
 1330 :
 1340 DEF PROCconvert8to6(input%,output%)
 1350 ?output%=(?input%<<2) OR (input%?1>>4)
 1360 output%?1=(input%?1<<4) OR (input%?2>>2)
 1370 output%?2=(input%?2<<6) OR input%?3
 1380 ENDPROC
 1390 :
 1400 DEF PROChelp(key$)
 1410 IF key$="?" THEN
 1420   PRINT"*TextToFile: Created By Damon Atkins  Copywrite ) 15/1/91"
 1430   PRINT"             Nomad International Software."
 1440   PRINT"             This Software is free and may be freely copied"
 1450   PRINT"             under the condition it is not altered in any way"
 1460   PRINT"             and that no price is charged for it."
 1470   PRINT" Purpose   : Converts text created by FileToText into a file,"
 1480   PRINT"             which have been received by electronic mail, etc."
 1490   PRINT"             <Text file>  : the text file created by FileToText"
 1500   PRINT"             <end of line>: end of line character in hex,"
 1510   PRINT"                            default is &0A eg. 0D"
 1520   PRINT" Syntax    : *TextToFile <Text file> [<end of line>]"
 1530 ELSE
 1540   PRINT" Syntax    : *TextToFile <Text file> [<end of line>]"
 1550   PRINT " For more information : *TextToFile ?"
 1560 ENDIF
 1570 ENDPROC
 1580 :
 1590 DEF FNfindInFile(channel%,search1$,search2$)
 1600 LOCAL found%,found1%,found2%,ptr%,len%
 1610 IF LEN(search1$)<LEN(search2$) THEN
 1620   PRINT "Err. Search String1<String2":END
 1630 ENDIF
 1640 len%=LEN(search1$)
 1650 found1%=FALSE : found2%=FALSE
 1660 ptr%=PTR#channel%
 1670 WHILE NOT(EOF#channel%) AND  NOT(found1% OR found2%)
 1680   SYS "OS_GBPB",3,channel%,Buffer%,len%,ptr%
 1690   found1%=FNcompare(search1$,Buffer%)
 1700   found2%=FNcompare(search2$,Buffer%)
 1710   ptr%+=1
 1720 ENDWHILE
 1730 PTR#channel%=ptr%-1
 1740 IF found1% THEN found%=1
 1750 IF found2% THEN found%=2
 1760 =found%
 1770 :
 1780 DEF FNcompare(a$,b%)
 1790 LOCAL n%,chk%
 1800 chk%=TRUE
 1810 b%-=1
 1820 FOR n%=1 TO LEN(a$)
 1830   chk%=chk% AND CHR$(b%?n%)=MID$(a$,n%,1)
 1840 NEXT n%
 1850 =chk%
 1860 :
 1870 REM End Of Programme  TextToFile

atkinsd@sol.cc.deakin.OZ.AU (Damon Atkins,Archimedes Services,0000,1111) (01/22/91)

***128.184.12.XX  note number.

This data is for use with TextToFile

%Begin message        FFFFFF42 E74B91B2 00000441 00000003
0=[dDCA\\XaO[TaxpVaK[SM<qTRDtCBHhSQlgCAToW=<nURL`CBLcTM<\TALmTRHnC=<jT]<rUA`^1
2U=<dWm<\X;doUAO[CBLjW=<jT]<oUAO[CAt`XrG[VAPoXAPmC=<hSRDfTQK[Xq`oU=;[SM;eE]cg3
4CA@nC?_[Sq@iCAtjX;dmTQp`VQD`W];[URK[CBDdTq\oC=<iVrWgC=<]TQTjWaO[CBPnTQ`iTm;[5
6La`gTPLjPAPsX=;[Vqs[CBLcURGi=[dOUAO[UQtaVrDhSRLdVqs[XA\\X=<DCA\\XaO[URG[XA\\7
8X=<dX=<mXQtnCA@aXAPmC>OuG><KNKd<XRHoWa@dVA@iCBLdVQOiC@XcUQHcCA`nCA@]VrPoC>Su9
0G><\VM<jW];rI^;kSQo[UQs[XA\`C@OiMmsEKQt_CAxiCBX`TQh`VaLnCA@iT=<ESQsiF=<ATQCi1
2C?p\WaHcF];aC@H`W=s[NaxqF]<?TQGiCA`oCA`nCBDpVatdVaWEVQxnX=<oUQp`WmsE=];[C@Lc3
4TM<SQ=<dV]<oUAO[SQL_WaPnWm<mSQtbTRG[TbDjVM;lG=<oVm;pG=<\VaK[URG[VQxnX=<jTbL`5
6V[c[C=<\V]<`XaPiCAtpVQD`W];[SQt_CA`iCBLcTM;oG=XnCAxmC>OkDrGiC@LcTM;[TbLkCBHd7
8XAOEC=;[SqxiXAPiXBG[Sq\\VaX`Wm<`XaPmYM;[XBXjCAL\YRGiC?@iT=<tVrO[CA@mTM<\VAlj9
0XqPnCBLjCA@_T;c[C=<oVm<oUAO[Wq`oTM<\Vb_[O?K[CAxmC@HcSRD`Pq@mTM<]XRK[URK[SQln1
2Vm<cSRT`CA?[VaxoTM<rURLc=];[CA`oCBLjCBH\YM<rUA@oCA`oC=<dWm<rUA@oCATdVAPnC=<\3
4WaO[UQt^VBP_TQKgCA@iC=<rUA@oCBLcTM;EC=;[Ta`gTRG[CA@mTMs[C?TdVAO[CAt\VQPnC=<h5
6XRHoCAD`CA`iCBLcTM<aVrDhSRK[L_TAL_TAL_SiP@LO=];[CBXcTRD`C?TAL_TAL_TACA`nCBLc7
8TM;[Ta`gTM<iSQp`C=<hSR[iC>[[VAPoXAPmWm<\VaK[P@LOCBLcTKc[C=<aUQl`CBLtWAOiC@Lc9
0TM<iVrL`CAxiCBLcTM<aUQl`CAppWrK[SaO[L_TAL_TAL_SiMOtSCA@nCA@]VrT`F[c[C=<\VaK[1
2WAl\SqPnCA`iCBLcTM<_URD`SrLjWb_[Sq@gVAP_C?`IO@POCBLjCAD`CB<mVqH`WrH`T=<]YM<o3
4UAOEC=;[Wq`oTM<hSQt\TqPmF]<OUAO[L?x>CATdVAO[Xq`gV=<]TM<\TAL`T=<oVm<\CA`iTAPs5
6CAxaCBLcTM<nURL`F;c[C=<dTM<NMPL@F_`IQ;c[C=;[C=;[C=;[C=;[C=;[C=;[C=;[C=;[C=;[7
8C=;[C=;ETM<nURL`F;c[C=<dTM<NMPL@F_`IQ;c[C=;[C=;[C=;[C=;[C=;[C=;[C=;[C=;[C=;[9
%End 00000014 000C28DE