10 REM > NetScan 1.04 J.G.Harston
   20 REM Lists stations connected and various information
   30 REM FNnet_Ping() doesn't work on Sprow ARMCoPro - works on all other CoPros
   40 :
   50 A%=0:X%=1:os%=(USR&FFF4 AND &FF00)DIV256
   60 DIM ctrl% 31,txBuf% 31,rxBuf% 63:X%=ctrl%:Y%=X%DIV256
   70 rx%=0:tx%=0:mystn%=FNnet_Info(8,0):nfs%=FNnet_Ping(FNnet_Info(0,0))<>0
   80 INPUT "Scan all networks? "A$:A$=LEFT$(A$,1):all%=A$="Y"ORA$="y"
   90 ON ERROR REPORT:PROCnet_RxKill(rx%):PRINT:END
  100 :
  110 PRINT"Station  Machine"SPC(16)"NetVers"SPC(3)"User"
  120 FOR net%=0 TO 127 AND all%:PROCscan(net%):NEXT
  130 END
  140 :
  150 DEFPROCscan(net%)
  160 IF FNnet_Bridge(net%)<0:ENDPROC:REM Unreachable
  170 FOR stn%=net%*256+1 TO net%*256+254
  180   ping%=0:IF stn%<>mystn%:ping%=FNnet_Ping(stn%):IF ping%=&03350001:ping%=FNpingFix(stn%)
  190   IF ping% OR stn%=mystn%:PROCprobe:PROCprint
  200 NEXT:ENDPROC
  210 :
  220 DEFPROCprint
  230 PRINT FNnet_StnFixed(stn%);
  240 PRINT MID$("* ",2+(stn%=mystn%),1);
  250 PRINT TAB(9);mch$;
  260 PRINT TAB(32);ver$;
  270 PRINT TAB(42);nfsUser$;
  280 IF srvFind%:IF srvError%=0:PRINT 'SPC(9);srvServ$;" ";FNh0(srvVers%,2);" ";srvName$;
  290 IF srvFind%:IF srvError%  :PRINT 'SPC(9);"Server error: ";srvError$;
  300 IF netServ%:PRINT 'SPC(9);nfsName$;
  310 IF netPrnt%:PRINT 'SPC(9);"Printer ";netPrnt$;" ";netStat$;
  320 REM Add any more results
  330 PRINT:ENDPROC
  340 :
  350 DEFPROCprobe
  360 nfsUser$=""
  370 netServ%=0
  380 netPrnt%=0
  390 srvFind%=0
  400 IF ping%  :mch$=FNnet_Type(ping%):ver$=FNver(ping%)
  410 IF ping%=0:mch$=FNmachine(os%)   :ver$=FNnetfs_ver
  420 IF nfs%   :nfsUser$=FNnetfs_Who(stn%)
  430 IF ping%=0 OR stn%=mystn%:ENDPROC:REM Local machine
  440 :
  450 PROCprobe_NetFS
  460 PROCprobe_PrintFS
  470 PROCprobe_Server
  480 REM Add any more probes
  490 ENDPROC
  500 :
  510 DEFPROCprobe_NetFS
  520 IF FNnet_Send(stn%,&80,&99,CHR$&B1+CHR$25+CHR$0+CHR$0+CHR$0,&B1,&30)=0:ENDPROC
  530 nfsName$=$(rxBuf%+2)
  540 netServ%=TRUE
  550 ENDPROC
  560 :
  570 DEFPROCprobe_PrintFS
  580 IF FNnet_Send(stn%,&80,&9F,"PRINT "+CHR$1+CHR$0,&9E,10)=0:ENDPROC
  590 netStat%=?rxBuf%
  600 netStat$=MID$("Idle  Busy  Jammed",(netStat%AND7)*6+1,6)
  610 IF FNnet_Send(stn%,&80,&9F,"PRINT "+CHR$6+CHR$0,&9E,10)=0:ENDPROC
  620 rxBuf%?6=13:netPrnt$=$rxBuf%
  630 netPrnt%=TRUE
  640 ENDPROC
  650 :
  660 DEFPROCprobe_Server
  670 IF FNnet_Send(stn%,&80,&B0,"        ",&B1,&20)=0:ENDPROC
  680 srvError%=?rxBuf%:IF srvError%:srvError$=$(rxBuf%+1)
  690 rxBuf%?(12+rxBuf%?11)=13:srvName$=$(rxBuf%+12)
  700 rxBuf%?11=13:srvServ$=$(rxBuf%+3)
  710 srvVers%=rxBuf%?2
  720 srvPort%=rxBuf%?1
  730 srvFind%=TRUE
  740 ENDPROC
  750 :
  760 REM Add any more probes
  770 :
  780 :
  790 REM Networking routines
  800 REM -------------------
  810 :
  820 DEFFNnet_Bridge(net%)
  830 IF net%=0:=0
  840 IF FNnet_Send(&FFFF,&83,&9C,"BRIDGE"+CHR$&B0+CHR$net%,&B0,&10)=0:=-1
  850 =rxBuf%?7
  860 :
  870 DEFFNnet_Send(stn%,txCtrl%,txPort%,txData$,rxPort%,rxLen%)
  880 $txBuf%=txData$:rx%=FNnet_RxOpen(stn%,rxPort%,rxBuf%,rxLen%):IF rx%=0:=0
  890 IF FNnet_TxCount(stn%,txCtrl%,txPort%,txBuf%,LENtxData$,0,5,25):PROCnet_RxKill(rx%):=0
  900 try%=10:REPEAT:rxok%=FNnet_Rx(rx%):IF NOT rxok%:A%=TIME+25:REPEATUNTILTIME>A%:try%=try%-1
  910 UNTIL rxok% OR try%<1:IF NOT rxok% THEN PROCnet_RxKill(rx%):=0
  920 =FNnet_RxRead(rx%)
  930 :
  940 DEFFNnet_Ping(S%):!X%=&88:X%!2=S%:X%!4=X%+16:X%!8=X%+20:X%!12=0:X%!16=0
  950 A%=&10:REPEATCALL&FFF1:UNTIL?X%:A%=&32:REPEATUNTIL(USR&FFF4 AND &8000)=0:=X%!16
  960 :
  970 DEFFNpingFix(S%):!X%=&81:X%!2=S%:X%!4=X%+16:X%!8=X%+20:X%!12=&FFFF820C:X%!16=0
  980 A%=&10:REPEATCALL&FFF1:UNTIL?X%:A%=&32:REPEATUNTIL(USR&FFF4 AND &8000)=0
  990 IFX%!16=&30342E33:=&03400001 ELSE =&03350001
 1000 :
 1010 DEFFNnet_TxCount(Stn%,Ctrl%,Port%,Addr%,Len%,RAddr%,Try%,Delay%):LOCAL TxErr%
 1020 DEFFNnet_Tx(Stn%,Ctrl%,Port%,Addr%,Len%,RAddr%):LOCAL TxErr%,Try%,Delay%:Try%=10:Delay%=50
 1030 X%?1=Port%:X%!2=Stn%:X%!4=Addr%:X%!8=Addr%+Len%:X%!12=RAddr%
 1040 IFStn%=&FFFF:X%!4=Addr%!0:X%!8=Addr%!4
 1050 REPEAT:REPEAT:X%?0=Ctrl%:A%=&10:CALL &FFF1:UNTILX%?0
 1060   REPEAT:TxErr%=FNbyte(&32,0,0):UNTILTxErr%<&80
 1070   IFTxErr%=&41 OR TxErr%=&42:IFTry%:A%=TIME+Delay%:REPEATUNTILTIME>A%:Try%=Try%-1
 1080 UNTILNOT(TxErr%=&41 OR TxErr%=&42) OR Try%<1:=TxErr%
 1090 :
 1100 DEFFNnet_RxOpen(Stn%,Port%,Addr%,Len%)
 1110 X%?0=0:X%?1=&7F:X%?2=Port%:X%!3=Stn%:X%!5=Addr%:X%!9=Addr%+Len%
 1120 A%=&11:CALL&FFF1:=X%?0
 1130 :
 1140 DEFFNnet_Rx(RxNum%):=(FNbyte(&33,RxNum%,0)AND&80)<>0
 1150 :
 1160 DEFFNnet_RxRead(RxNum%)
 1170 X%?0=RxNum%:A%=&11:CALL&FFF1:A%=X%!9-X%!5:X%!5=0:=A%
 1180 :
 1190 DEFPROCnet_RxKill(RxNum%):A%=FNbyte(&34,RxNum%,0):ENDPROC
 1200 :
 1210 DEFFNnet_Info(A%,D%):?X%=A%:X%!1=D%:A%=&13:CALL&FFF1:=X%!1
 1220 :
 1230 DEFFNnet_Stn(A%):=LEFT$(FNd0(A%DIV256,3)+".",(A%DIV256)<>0)+FNd0(A%AND255,3)
 1240 DEFFNnet_StnFixed(A%):=FNd0(A%DIV256,3)+"."+FNd0(A%AND255,3)
 1250 DEFFNnet_Err(A%):IFA%=0:=""
 1260 =MID$("Line jammedNet errorNot listeningNo clockBad Tx blockNo reply",VALMID$("011221344254",(A%-&40)*2+1,2),VALMID$("110913081208",(A%-&40)*2+1,2))
 1270 :
 1280 DEFFNnet_Type(A%):LOCAL A$:A%=A%AND&FFFF
 1290 IF A%DIV256=&00:A$="Acorn "
 1300 IF A%DIV256=&01:A$="Torch "
 1310 IF A%DIV256=&02:A$="Reuters "
 1320 IF A%DIV256=&50:A$="PhilBlundell "
 1330 IF A%DIV256=&FF:A$="SJ Research "
 1340 :
 1350 A%=A%AND255
 1360 IF A%=1:=A$+"BBC Micro"
 1370 IF A%=2:=A$+"Atom"
 1380 IF A%=3:=A$+"System 3/4"
 1390 IF A%=4:=A$+"System 5"
 1400 IF A%=5:=A$+"Master 128"
 1410 IF A%=6:=A$+"Electron"
 1420 IF A%=7:=A$+"RISC OS"
 1430 REMA%=8:=A$+"Reserved"
 1440 IF A%=9:="A$+Communicator"
 1450 IF A%=10:=A$+"Master ET"
 1460 IF A%=11:=A$+"Filestore"
 1470 IF A%=12:=A$+"Master Compact"
 1480 IF A%=13:=A$+"PC EcoLink"
 1490 IF A%=14:=A$+"RISCiX Workstation"
 1500 IF A%=15:=A$+"RISC PC"
 1510 IF A%=16:=A$+"Iyonix"
 1520 IF A%=17:=A$+"A9"
 1530 :
 1540 IF A%=&40:=A$+"ZX Spectrum"
 1550 IF A%=&41:=A$+"Amstrad CPC"
 1560 IF A%=&50:=A$+"Internet Gateway"
 1570 IF A%=&EE:=A$+"Rasberry Pi"
 1580 IF A%=&F8:=A$+"GP Server"
 1590 IF A%=&F9:=A$+"80386 Unix"
 1600 IF A%=&FA:=A$+"SCSI Interface"
 1610 IF A%=&FB:=A$+"PC Card"
 1620 IF A%=&FC:=A$+"Nascom 2"
 1630 IF A%=&FD:=A$+"RM480Z"
 1640 IF A%=&FE:=A$+"FileServer"
 1650 IF A%=&FF:=A$+"380Z or CP/M"
 1660 =A$+"["+FNh0(A%,4)+"]"
 1670 :
 1680 :
 1690 REM NetFS routines
 1700 REM --------------
 1710 :
 1720 DEFFNnetfs_ver
 1730 IFos%>6:=""
 1740 IFos%=6:IFHIMEM>&FFFF:SYS&1E,18,"Econet"TO,,,A%:SYS&46,A%+A%!20TOA$:=MID$(A$,9,4)
 1750 LOCAL X%,Y%,F%,A$:Y%=0:X%=&70
 1760 A%=0:F%=(USR&FFDA)AND&FF:*FX143,18,5
 1770 A%=4:IF((USR&FFDA)AND&FF)=4:A$="3.4x-3.6x" :REM 3.34, 3.35, 3.40, 3.60, 3.62, 3.65
 1780 A%=3:IF((USR&FFDA)AND&FF)=0:A$="4.0x-4.1x" :REM 4.08, 4.18, 4.21, 4.25
 1790 A%=2:IF((USR&FFDA)AND&FF)=2:A$="3.3x"      :REM 3.34, 3.35
 1800 A%=1:IF((USR&FFDA)AND&FF)>0:A$="4.2x"      :REM 4.21, 4.25
 1810 OSCLI"FX143,18,"+STR$F%:=A$
 1820 :
 1830 DEFFNnetfs_Who(stn%):LOCALu%:REPEAT:A%=FNnetfs_Op(15,CHR$u%+CHR$1)
 1840 u%=u%+1:UNTILA%<>0ORX%?4=0ORX%?5=stn%:IFA%=0:IFX%?4:=$(X%+7) ELSE =""
 1850 :
 1860 DEFFNnetfs_Op(A%,A$)=FNnetfs_OpN(A%,0,7,A$)
 1870 DEFFNnetfs_OpN(A%,T%,O%,A$):!X%=0:X%?1=O%+1+LENA$:X%!3=A%
 1880 IFHIMEM>&FFFF:X%?4=T%:$(X%+O%-3)=A$:SYS&60048,A%,X%+4,O%+LENA$,120TOA%:IFA%=0:X%?3=0:=0
 1890 IFHIMEM>&FFFF:IFA%>&FFFF:X%?3=?A%:SYS&2002B,A%+4TO$(X%+4):=X%?3
 1900 X%!4=0:X%?7=T%:$(X%+O%)=A$:A%=&14:CALL&FFF1:=X%?3
 1910 :
 1920 :
 1930 REM Misc. routines
 1940 REM --------------
 1950 DEFFNbyte(A%,X%,Y%)=((USR&FFF4)AND&FF00)DIV256
 1960 DEFFNver(A%):=LEFT$(FNh0(A%,8+((A%AND&F0000000)=0)),1)+"."+MID$(FNh0(A%,8),3,2)
 1970 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
 1980 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
 1990 DEFFNd(A%,N%)=RIGHT$("        "+STR$A%,N%)
 2000 :
 2010 DEFFNmachine(A%)
 2020 IF A%=0:="Electron"
 2030 IF A%=1:="BBC Micro"
 2040 IF A%=2:="BBC B+"
 2050 IF A%=3:="Master 128"
 2060 IF A%=4:="Master ET"
 2070 IF A%=5:="Master Compact"
 2080 IF A%=6:="RISC OS"
 2090 ="[Type "+STR$A%+"]"
 2100 :

Download NetScan

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.