home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / file_trans / bbc__arc / !BBC / BBC9 < prev    next >
Encoding:
Text File  |  1990-10-24  |  7.5 KB  |  297 lines
  1. >L.
  2.  
  3.    10REM Remote control server program #2
  4.  
  5.    20REM to be loaded into BBC
  6.  
  7.    30DIM b% 310
  8.  
  9.    40DIM f$(32)
  10.  
  11.    50DIM cb% 32
  12.  
  13.    60DIM osbuff% 100
  14.  
  15.    70DIM transbuff% 256
  16.  
  17.    80FOR A%=b% TO b%+300:?A%=0:NEXT
  18.  
  19.    90end%=0
  20.  
  21.    91*fx 3 0
  22.  
  23.    92*fx 2 1
  24.  
  25.   100INPUT"Baud reference:"rate%
  26.  
  27.   101*fx 2 2
  28.  
  29.   110unlock%=0
  30.  
  31.   120dir$=":0.$"
  32.  
  33.   130SOUND 2,-15,200,2:SOUND 2,0,200,1:SOUND 2,-15,200,2
  34.  
  35.   140ON ERROR OSCLI("FX 3 0"):OSCLI("FX 2 2"):PRINT"Error!":REPORT:PRINT" at line ";ERL:SOUND 1,-15,0,5:END
  36.  
  37.   150:
  38.  
  39.   160CLS
  40.  
  41.   170PRINT'CHR$141;"   BBC to Archimedes file transfer"'CHR$141;"   BBC to Archimedes file transfer"
  42.  
  43.   180PRINT'"Do not type anything here; the Arc"'"has full control."'"Facilities include file transfer either"'"way, and BBC file renaming and deletion."'
  44.  
  45.   190*FX 3 3
  46.  
  47.   200VDU 32
  48.  
  49.   210*fx 3 0
  50.  
  51.   220REPEAT
  52.  
  53.   230PRINT"Awaiting command from Archimedes"
  54.  
  55.   240*fx 2 1
  56.  
  57.   250*fx 3 0
  58.  
  59.   260INPUT com$
  60.  
  61.   270IF com$="catalogue" THEN PROCcat
  62.  
  63.   280IF com$="delete file" THEN PROCdel
  64.  
  65.   290IF com$="transfer to arc" THEN PROCtrans
  66.  
  67.   300IF com$="quit" THEN PROCquit
  68.  
  69.   310IF com$="transfer to bbc" THEN PROCtransbbc
  70.  
  71.   320IF com$="rename" THEN PROCrename
  72.  
  73.   330IF com$="baud" THEN PROCbaud
  74.  
  75.   340IF com$="lock" THEN PROClock
  76.  
  77.   350IF com$="lock file" THEN PROClockfile
  78.  
  79.   360*FX 3 0
  80.  
  81.   370UNTIL end%
  82.  
  83.   380END
  84.  
  85.   390:
  86.  
  87.   400DEFPROCquit
  88.  
  89.   410end%=-1
  90.  
  91.   420*FX 3 0
  92.  
  93.   430*FX 2 2
  94.  
  95.   440PRINT"Ending session"'
  96.  
  97.   450SOUND 1,-15,100,5
  98.  
  99.   460ENDPROC
  100.  
  101.   470:
  102.  
  103.   480DEFPROCdel
  104.  
  105.   490*fx 2 1
  106.  
  107.   500*fx 3 0
  108.  
  109.   510PRINT"Delete; File: ";dir$;".";
  110.  
  111.   520INPUTLINE""file$
  112.  
  113.   530ok%=FNokalter(file$)
  114.  
  115.   540IF ok% THEN OSCLI("Delete "+dir$+"."+file$)
  116.  
  117.   550*fx 3 3
  118.  
  119.   560*fx 2 2
  120.  
  121.   570IF ok% THEN PRINT"deleted";CHR$13; ELSE PRINT"locked";CHR$13;
  122.  
  123.   580*fx 3 0
  124.  
  125.   590ENDPROC
  126.  
  127.   600:
  128.  
  129.   610DEFPROCrename
  130.  
  131.   620*FX 2 1
  132.  
  133.   630*FX 3 0
  134.  
  135.   640INPUT'"Rename; old file:"old$
  136.  
  137.   650INPUTLINE"New file:"new$
  138.  
  139.   660ok%=FNokalter(old$)
  140.  
  141.   670IF ok% THEN OSCLI("rename "+dir$+"."+old$+" "+dir$+"."+new$)
  142.  
  143.   680*fx 3 3
  144.  
  145.   690*fx 2 2
  146.  
  147.   700IF ok% THEN PRINT"renamed";CHR$13; ELSE PRINT"locked";CHR$13;
  148.  
  149.   710*fx 3 0
  150.  
  151.   720ENDPROC
  152.  
  153.   730:
  154.  
  155.   740DEFPROCcat
  156.  
  157.   750*fx 3 0
  158.  
  159.   760INPUT"Directory:"dir$
  160.  
  161.   770OSCLI("Dir "+dir$)
  162.  
  163.   780PRINT"Reading catalogue"
  164.  
  165.   790FOR f%=0 TO 32:f$(f%)="":NEXT
  166.  
  167.   800FOR byte%=b% TO b%+300 STEP 4:!byte%=0:NEXT
  168.  
  169.   810*CAT
  170.  
  171.   820*FX 2 2
  172.  
  173.   830X%=cb% MOD 256
  174.  
  175.   840Y%=cb% DIV 256
  176.  
  177.   850A%=8
  178.  
  179.   860cb%?0=0
  180.  
  181.   870cb%!1=b%
  182.  
  183.   880cb%!5=32
  184.  
  185.   890cb%!9=0
  186.  
  187.   900CALL &FFD1
  188.  
  189.   910files%=0
  190.  
  191.   920p%=b%
  192.  
  193.   930REPEAT
  194.  
  195.   940IF FNfname(p%)<>"" THEN files%=files%+1:f$(files%)=FNfname(p%):p%=p%+?p%+1
  196.  
  197.   950UNTIL ?p%=0
  198.  
  199.   960PRINT"Sending ";files%;" filenames"
  200.  
  201.   970*FX 3 3
  202.  
  203.   980PRINT files%;CHR$13;
  204.  
  205.   990IF files%=0 THEN PRINT" ";CHR$13;:OSCLI("FX 3 0"):ENDPROC
  206.  
  207.  1000FOR f%=1 TO files%
  208.  
  209.  1010PRINT;f$(f%);CHR$13;
  210.  
  211.  1020*fx 3 0
  212.  
  213.  1030PRINT f$(f%)
  214.  
  215.  1040*fx 3 3
  216.  
  217.  1050$(osbuff%+30)=LEFT$(f$(f%),68)
  218.  
  219.  1060!osbuff%=osbuff%+30
  220.  
  221.  1070X%=osbuff% MOD 256
  222.  
  223.  1080Y%=osbuff% DIV 256
  224.  
  225.  1090A%=5
  226.  
  227.  1100A%=USR(&FFDD) AND 255
  228.  
  229.  1110PRINTosbuff%!10;CHR$13;
  230.  
  231.  1120PRINTosbuff%!14;CHR$13;
  232.  
  233.  1130PRINTFNfiletype(f$(f%));CHR$13;
  234.  
  235.  1140NEXT
  236.  
  237.  1150*FX 3 0
  238.  
  239.  1160ENDPROC
  240.  
  241.  1170:
  242.  
  243.  1180DEFPROCtrans
  244.  
  245.  1190*FX 2 1
  246.  
  247.  1200*FX 3 2
  248.  
  249.  1210INPUTLINE f$
  250.  
  251.  1220type%=FNfiletype(f$)
  252.  
  253.  1230FH%=OPENIN(f$)
  254.  
  255.  1240*FX 3 3
  256.  
  257.  1250PRINT;EXT#FH%;CHR$13;
  258.  
  259.  1260PRINT;type%;CHR$13;
  260.  
  261.  1270*FX 2 1
  262.  
  263.  1280*FX 3 2
  264.  
  265.  1290INPUT OK$
  266.  
  267.  1300*FX 2 2
  268.  
  269.  1310*FX 3 0
  270.  
  271.  1320IF OK$<>"OK" THEN PRINT"Communication error":ENDPROC ELSE PRINT"Sending"
  272.  
  273.  1330*FX 3 3
  274.  
  275.  1340FOR F%=1 TO EXT#FH%
  276.  
  277.  1350VDU BGET#FH%
  278.  
  279.  1360NEXT
  280.  
  281.  1370*FX 3 0
  282.  
  283.  1380CLOSE#FH%
  284.  
  285.  1390PRINT"Finish";
  286.  
  287.  1400*FX 2 1
  288.  
  289.  1410*FX 3 2
  290.  
  291.  1420INPUT OK$
  292.  
  293.  1430*FX 2 2
  294.  
  295.  1440*FX 3 0
  296.  
  297.  1450IF OK$="OK" THEN PRINT"ed"'
  298.  
  299.  1460ENDPROC
  300.  
  301.  1470:
  302.  
  303.  1480DEFPROCtransbbc
  304.  
  305.  1490*fx 2 1
  306.  
  307.  1500*fx 3 0
  308.  
  309.  1510ok%=-1
  310.  
  311.  1520PRINT"Receiving file to ";dir$
  312.  
  313.  1530INPUTLINE"Filename:"file$
  314.  
  315.  1540INPUT"Length:"len%
  316.  
  317.  1550F%=OPENIN(dir$+"."+file$)
  318.  
  319.  1560IF F%<>0 THEN CLOSE#F%:ok%=FNokalter(dir$+"."+file$)
  320.  
  321.  1570IF ok% THEN F%=OPENOUT(dir$+"."+file$)
  322.  
  323.  1580*fx 3 3
  324.  
  325.  1590*fx 2 2
  326.  
  327.  1600IF ok% THEN PRINT"receiving";CHR$13; ELSE PRINT"locked";CHR$13;
  328.  
  329.  1610*fx 2 1
  330.  
  331.  1620*FX 3 0
  332.  
  333.  1630FOR block%=1 TO len% STEP 128
  334.  
  335.  1640fails%=0
  336.  
  337.  1650REPEAT
  338.  
  339.  1660crc%=0
  340.  
  341.  1670FOR byte%=block% TO FNlower(block%+127,len%)
  342.  
  343.  1680g%=GET
  344.  
  345.  1690?(transbuff%-block%+byte%)=g%
  346.  
  347.  1700crc%=crc%+g%
  348.  
  349.  1710NEXT
  350.  
  351.  1720*fx 3 3
  352.  
  353.  1730PRINT crc%;CHR$13;
  354.  
  355.  1740*FX 3 2
  356.  
  357.  1750INPUT confirm$
  358.  
  359.  1760IF confirm$<>"crc ok" THEN fails%=fails%+1:SOUND 1,-15,0,2
  360.  
  361.  1770UNTIL confirm$="crc ok" OR fails%>=3
  362.  
  363.  1780IF fails%>=3 THEN OSCLI("FX 3 0"):OSCLI("FX 2 2"):CLOSE#0:PRINT'"Failed to transfer block":END
  364.  
  365.  1790FOR byte%=block% TO FNlower(block%+127,len%)
  366.  
  367.  1800BPUT#F%,?(transbuff%-block%+byte%)
  368.  
  369.  1810NEXT
  370.  
  371.  1820NEXT
  372.  
  373.  1830REM FOR byte%=1 TO len%
  374.  
  375.  1840REM BPUT#F%,GET
  376.  
  377.  1850REM NEXT
  378.  
  379.  1860CLOSE#F%
  380.  
  381.  1870$(osbuff%+30)=dir$+"."+file$
  382.  
  383.  1880!osbuff%=osbuff%+30
  384.  
  385.  1890osbuff%!2=0
  386.  
  387.  1900X%=osbuff% MOD 256
  388.  
  389.  1910Y%=osbuff% DIV 256
  390.  
  391.  1920A%=2
  392.  
  393.  1930CALL&FFDD
  394.  
  395.  1940osbuff%!6=0
  396.  
  397.  1950A%=3
  398.  
  399.  1960CALL&FFDD
  400.  
  401.  1970*fx 2 2
  402.  
  403.  1980*fx 3 3
  404.  
  405.  1990PRINT"finished";CHR$13;
  406.  
  407.  2000*fx 3 0
  408.  
  409.  2010ENDPROC
  410.  
  411.  2020:
  412.  
  413.  2030DEFPROCbaud
  414.  
  415.  2040old%=rate%
  416.  
  417.  2050*fx 2 1
  418.  
  419.  2060*fx 3 0
  420.  
  421.  2070INPUT'"New baud index:"rate%
  422.  
  423.  2080OSCLI("FX 7,"+STR$(rate%))
  424.  
  425.  2090OSCLI("FX 8,"+STR$(rate%))
  426.  
  427.  2100*fx 3 3
  428.  
  429.  2110PRINT"baud reset";CHR$13;
  430.  
  431.  2120*fx 3 0
  432.  
  433.  2130*fx 2 1
  434.  
  435.  2140i$=""
  436.  
  437.  2150REPEAT
  438.  
  439.  2160i%=INKEY(100)
  440.  
  441.  2170IF i%<>13 AND i%<>-1 THEN i$=i$+CHR$(i%)
  442.  
  443.  2180UNTIL i%=13 OR i%=-1
  444.  
  445.  2190IF i$<>"baud confirm" THEN OSCLI("FX 7,"+STR$(old%)):OSCLI("FX 8,"+STR$(old%)):OSCLI("FX 3,0"):PRINT"Failed to confirm new speed":rate%=old%
  446.  
  447.  2200ENDPROC
  448.  
  449.  2210:
  450.  
  451.  2220DEFFNfname(p%)
  452.  
  453.  2230LOCAL f$
  454.  
  455.  2240IF ?p%=0 THEN =""
  456.  
  457.  2250FOR c%=p%+1 TO p%+?p%
  458.  
  459.  2260f$=f$+CHR$(?c%)
  460.  
  461.  2270NEXT
  462.  
  463.  2280=f$
  464.  
  465.  2290:
  466.  
  467.  2300DEFFNfiletype(file$)
  468.  
  469.  2310LOCAL X%,Y%,A%,loadaddr%,execaddr%,attrib%,lenfile%
  470.  
  471.  2320$(osbuff%+30)=LEFT$(file$,68)
  472.  
  473.  2330!osbuff%=osbuff%+30
  474.  
  475.  2340X%=osbuff% MOD 256
  476.  
  477.  2350Y%=osbuff% DIV 256
  478.  
  479.  2360A%=5
  480.  
  481.  2370A%=USR(&FFDD) AND 255
  482.  
  483.  2380REM OSFILE read catalogue information
  484.  
  485.  2390loadaddr%=osbuff%!2
  486.  
  487.  2400execaddr%=osbuff%!6
  488.  
  489.  2410lenfile%=osbuff%!10
  490.  
  491.  2420attrib%=osbuff%!14
  492.  
  493.  2430IF (attrib% AND 1)=1 THEN =0
  494.  
  495.  2440REM type 0 means not transferrable
  496.  
  497.  2450IF loadaddr%=&8000 AND (lenfile% AND &2000) THEN =&BBC
  498.  
  499.  2460IF (loadaddr% AND &FFFFFF)=&FFFFFF AND (execaddr% AND &FFFFFF)=&FFFFFF THEN =&FFF
  500.  
  501.  2470la%=loadaddr% AND &FFFF
  502.  
  503.  2480IF (la%=&E00 OR la%=&1200 OR la%=&1900 OR la%=&1B00) AND (execaddr% AND &FFFF)>&8000 THEN =&FFB
  504.  
  505.  2490X%=OPENIN(file$)
  506.  
  507.  2500PTR#X%=EXT#X%-1
  508.  
  509.  2510lastbyte%=BGET#X%
  510.  
  511.  2520CLOSE#X%
  512.  
  513.  2530IF (execaddr% AND &FFFFFF)=&FFFFFF AND loadaddr%=0 AND lastbyte%=13 THEN =&FFE
  514.  
  515.  2540IF (execaddr% AND &FFFFFF)=&FFFFFF AND loadaddr%=0 AND lastbyte%<>13 THEN =&FFD
  516.  
  517.  2550IF (la%+lenfile%)=&8000 AND (la%=&3000 OR la%=&5800 OR la%=&7C00) THEN =&FF9
  518.  
  519.  2560=-1
  520.  
  521.  2570:
  522.  
  523.  2580DEFFNokalter(file$)
  524.  
  525.  2590$(osbuff%+30)=file$
  526.  
  527.  2600!osbuff%=osbuff%+30
  528.  
  529.  2610X%=osbuff% MOD 256
  530.  
  531.  2620Y%=osbuff% DIV 256
  532.  
  533.  2630A%=5
  534.  
  535.  2640CALL&FFDD
  536.  
  537.  2650locked%=osbuff%!14 AND 8
  538.  
  539.  2660IF locked% THEN locked%=-1
  540.  
  541.  2670IF locked% AND unlock% THEN OSCLI("Access "+file$):locked%=0
  542.  
  543.  2680=NOT locked%
  544.  
  545.  2690:
  546.  
  547.  2700DEFPROClock
  548.  
  549.  2710INPUT unlock%
  550.  
  551.  2720ENDPROC
  552.  
  553.  2730:
  554.  
  555.  2740DEFFNlower(a,b)
  556.  
  557.  2750IF a<b THEN b=a:REM........................
  558.  
  559.  2760=b
  560.  
  561.  2770:
  562.  
  563.  2780DEFPROClockfile
  564.  
  565.  2790LOCAL l$,lock%,file$
  566.  
  567.  2800*FX 3 2
  568.  
  569.  2810*FX 2 1
  570.  
  571.  2820INPUT file$
  572.  
  573.  2830INPUT lock%
  574.  
  575.  2840l$=""
  576.  
  577.  2850IF lock% THEN l$=" L"
  578.  
  579.  2860OSCLI("Access "+file$+l$)
  580.  
  581.  2870*fx 3 3
  582.  
  583.  2880*fx 2 2
  584.  
  585.  2890PRINT"locked";CHR$13;
  586.  
  587.  2900*fx 3 0
  588.  
  589.  2910ENDPROC
  590.  
  591. >*Spool
  592.  
  593.