home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / bbs / fscan157 / fscan157.gfa (.txt) next >
GFA-BASIC Atari  |  1992-05-02  |  34KB  |  1,620 lines
  1. ' FidoNet Scanning program. (C) D.M.Brewood, 1990,1991,1992
  2. ' Graphics/Windows & Registration Code (C) P.Gadsby 1991,1992
  3. '
  4. ' test = 0 for running, 1 = for testing
  5. '
  6. ' Mail Packet type:   way2go = 387 for CrashMail, or 385 for Routed
  7. '
  8. tt%=TIMER
  9. CLOSEW 0
  10. CLOSEW #0
  11. EVERY 600 GOSUB show_it
  12. sysop_reg
  13. sysreg%=1
  14. key_check%=0
  15. CLS
  16. IF XBIOS(4)=0
  17.   CLS
  18.   ALERT 1,"* Medium or HiRes ONLY *",1,"Whoops!",a%
  19.   CLOSE
  20.   CLOSEW #0
  21.   END
  22. ENDIF
  23. way2go%=387
  24. aaa#=FRE(x#)
  25. DEFINT "a-z"
  26. pos%=0
  27. '
  28. test#=0
  29. ver$="1.57"
  30. '
  31. IF INSTR(ver$,"b")
  32.   note$="BETA RELEASE ONLY - NOT FOR DISTRIBUTION!!!!!"
  33. ENDIF
  34. '
  35. '
  36. max_rec#=500
  37. pro$="Init master arrays"
  38. addr_pointer%=0
  39. max_address%=100
  40. coder_address$="2:255/401.0"
  41. DIM adr#(31),master_index$(100),map$(31,max_rec#)
  42. DIM day_ad$(31,max_rec#+50)
  43. DIM baud#(5)
  44. DIM xaddress$(max_address%),seenby$(max_address%)
  45. ' ON ERROR GOSUB cleanup
  46. ON BREAK GOSUB shutdown
  47. pro$="Does fidocall.dat exist?"
  48. IF EXIST("fidocall.dat")
  49.   main_routine
  50. ELSE
  51.   pro$="FIDOCALL.DAT not found......"
  52.   PRINT "FIDOCALL.DAT not found......"
  53.   PAUSE 100
  54.   CLOSE
  55.   END
  56. ENDIF
  57. CLOSE
  58. barchart
  59. reg_checker
  60. barsum
  61. reg_checker
  62. CLOSE #3
  63. mes_count
  64. CLOSE
  65. bbb%=FRE(x%)
  66. IF test#
  67.   PRINT "Memory used: ";aaa#-bbb%;" bytes."
  68. ENDIF
  69. PRINT "Time taken to execute F-Scan:";(TIMER-tt%)/200;" seconds."
  70. PAUSE 100
  71. CLOSEW #2
  72. CLOSEW #1
  73. CLOSEW #0
  74. CLOSEW 0
  75. END
  76. '
  77. ' ********************************************
  78. ' *           START OF PROCEDURES            *
  79. ' ********************************************
  80. '
  81. '
  82. > PROCEDURE main_routine
  83.   pro$="main routine"
  84.   title
  85.   pjgsize%=60
  86.   pjgdown%=135
  87.   pjgdown2%=120
  88.   IF XBIOS(4)=2
  89.     pjgsize%=110
  90.     pjgdown%=270
  91.     pjgdown2%=250
  92.   ENDIF
  93.   TITLEW #2," Approvals: "
  94.   OPENW #2,440,pjgdown2%/2,124,pjgsize%/2,0
  95.   '
  96.   PRINT
  97.   PRINT "NeST: 01224-923";
  98.   '
  99.   '
  100.   OPENW #1,4,pjgdown%,632,pjgsize%,&H10
  101.   PRINT
  102.   set_mask
  103.   inf_read
  104.   key_confirm
  105.   set_var
  106.   notify_reg
  107.   reg_checker
  108.   init_io
  109.   main_loop
  110. RETURN
  111. > PROCEDURE set_var
  112.   pro$="set_var"
  113.   offset#=5
  114.   adr_max#=0
  115.   marker$=LEFT$(DATE$,2)
  116.   marker$=STR$(INT(VAL(marker$)))
  117.   mark#=VAL(marker$)
  118.   IF test#
  119.     mark#=31
  120.   ENDIF
  121.   call$="I"
  122.   pprint$=""
  123.   mess_stat$=""
  124.   xfer$=""
  125.   sysop$=""
  126.   tick$=""
  127.   pass$=" "
  128.   daron$=""
  129. RETURN
  130. > PROCEDURE main_loop
  131.   pro$="main loop"
  132.   REPEAT
  133.     pro$="repeat"
  134.     LINE INPUT #1,bink_line$
  135.     pro$="line input #1,bink_line$"
  136.     IF INSTR(bink_line$," BINK ") OR INSTR(bink_line$," COME ")
  137.       IF INSTR(bink_line$," TIDY ")=0 OR INSTR(bink_line$," ECHOFIX ")=0 OR INSTR(bink_line$,"INTRO")=0
  138.         scan
  139.         pro$="scan"
  140.         count_baud
  141.         pro$="count baud"
  142.       ENDIF
  143.     ENDIF
  144.   UNTIL EOF(#1)
  145.   IF tot_call#<>0
  146.     give_stats
  147.   ENDIF
  148.   key
  149. RETURN
  150. > PROCEDURE change_date
  151.   pro$="change date"
  152.   marker$=MID$(bink_line$,3,2)
  153.   mark_new#=VAL(marker$)
  154.   marker$=STR$(mark_new#)
  155.   IF mark_new#>=1 AND mark_new#<=31 AND mark_new#<>mark#
  156.     mark#=mark_new#
  157.     CLOSE #4
  158.     day_dat$="fscan."+marker$
  159.     IF test#
  160.       PRINT
  161.       PRINT "day_dat$= ";day_dat$
  162.       PRINT
  163.     ENDIF
  164.     '
  165.     IF EXIST(store$+day_dat$)
  166.       OPEN "a",#4,store$+day_dat$
  167.     ELSE
  168.       OPEN "o",#4,store$+day_dat$
  169.     ENDIF
  170.     '
  171.   ENDIF
  172. RETURN
  173. > PROCEDURE count_baud
  174.   pro$="count baud"
  175.   IF INSTR(UPPER$(bink_line$),"EXITING TO")
  176.     IF INSTR(UPPER$(bink_line$),"EXITING TO EXTERNAL MAILER")
  177.       INC ext_mail#
  178.       IF test#
  179.         PRINT "Exiting to external mailer."
  180.       ENDIF
  181.     ENDIF
  182.     RESTORE meek
  183.     FOR q#=1 TO 4
  184.       READ pk#
  185.       IF INSTR(UPPER$(bink_line$),"EXITING TO BBS WITH ERRORLEVEL "+STR$(pk#))
  186.         INC baud#(q#)
  187.         INC tot_call#
  188.         IF test#
  189.           PRINT "Exiting with errorlevel ";pk#
  190.         ENDIF
  191.       ENDIF
  192.     NEXT q#
  193.   ENDIF
  194. RETURN
  195. > PROCEDURE give_stats
  196.   pro$="give stats"
  197.   tot$="            External mailers     "+STR$(ext_mail#,4)+"."
  198.   IF test#
  199.     PRINT
  200.     PRINT tot$
  201.   ENDIF
  202.   PRINT #2
  203.   PRINT #2,tot$
  204.   tot$="            User's Calls Found   "+STR$(tot_call#,4)+"."
  205.   IF test#
  206.     PRINT
  207.     PRINT tot$
  208.   ENDIF
  209.   PRINT #2
  210.   PRINT #2,tot$
  211.   PRINT #2
  212.   RESTORE meek
  213.   FOR x#=1 TO 4
  214.     READ pk#
  215.     IF pk#=3
  216.       pad$=" "
  217.     ELSE
  218.       pad$=""
  219.     ENDIF
  220.     calc$="            Callers at "+pad$+STR$(pk#*100)+" baud "+STR$(baud#(x#),4)+".       Percentage: "+STR$(baud#(x#)/tot_call#*100,4)+"%."
  221.     IF test#
  222.       PRINT calc$
  223.     ENDIF
  224.     PRINT #2,calc$
  225.   NEXT x#
  226. RETURN
  227. > PROCEDURE init_io
  228.   pro$="init io"
  229.   IF EXIST(binkley.log$)
  230.     OPEN "i",#1,binkley.log$
  231.   ELSE
  232.     CLOSE
  233.     pro$="binkley logfile not found..(CLOSE)"
  234.     END
  235.   ENDIF
  236.   OPEN "o",#2,binkley.out$
  237.   OPEN "o",#3,store$+"Msglog.dat"
  238.   day_dat$="fscan."+marker$
  239.   OPEN "o",#4,store$+day_dat$
  240.   title1$="  F-Scan "+ver$+". Binkley Mail Activity. © D.M.Brewood & P.Gadsby, 1990,91,92."
  241.   title2$="     FidoNet: 2:255/401.0  NeST: 90:1/0.0"
  242.   PRINT #2
  243.   PRINT #2,title1$
  244.   PRINT #2,title2$
  245.   PRINT #2
  246.   PRINT #2," Date/Timestamp:      Address:            SysOp/BBS if Poll:  Xfer:   Cll/Sts:"
  247.   PRINT #2," -------------------  ------------------- ------------------- ------  --------"
  248. RETURN
  249. > PROCEDURE inf_read
  250.   IF EXIST("FIDOCALL.DAT")
  251.     pro$="*ERROR in the format of FIDOCALL.DAT* - Check the documentation!"
  252.     OPEN "i",#1,"fidocall.dat"
  253.     pro$="open #1,'fidocall.dat'"
  254.     LINE INPUT #1,binkley.log$
  255.     pro$="line input #1,binkley.log$"
  256.     '    PRINT binkley.log$
  257.     '    binkley.log$="e:\bink.log$"
  258.     LINE INPUT #1,binkley.out$
  259.     pro$="line input #1,binkley.out$"
  260.     LINE INPUT #1,out_log$
  261.     pro$="line input #1,out_log$"
  262.     LINE INPUT #1,barchart$
  263.     pro$="line input #1,barchart$"
  264.     LINE INPUT #1,store$
  265.     pro$="line input #1,store$"
  266.     LINE INPUT #1,cfg_file$
  267.     pro$="line input #1,cfg_file$"
  268.     LINE INPUT #1,areas$
  269.     pro$="line input #1,areas$"
  270.     LINE INPUT #1,netmail$
  271.     netmail$=TRIM$(netmail$)
  272.     pro$="line input #1,netmail$"
  273.     IF NOT EOF(#1)
  274.       LINE INPUT #1,key$
  275.       key$=TRIM$(key$)
  276.       pro$="line input #1,key$"
  277.       key$=TRIM$(MID$(key$,4))
  278.     ENDIF
  279.     CLOSE #1
  280.   ELSE
  281.     pro$="*ERROR - FIDOCALL.DAT not found!"
  282.   ENDIF
  283. RETURN
  284. > PROCEDURE title
  285.   pro$="title"
  286.   pjgrez%=XBIOS(4)
  287.   CLS
  288.   RBOX 1,1,638,132*pjgrez%
  289.   width%=610
  290.   DEFTEXT 1,25,0,32
  291.   TEXT 10,32,width%,"FidoNet Call Analysis. V"+ver$
  292.   DEFTEXT 1,16,0,13
  293.   TEXT 100,54*pjgrez%,"(C) D.M.Brewood & P.J.Gadsby 1990,1991,1992. "
  294.   DEFTEXT 1,0,0,4
  295.   TEXT 200,63*pjgrez%," For Support Contact:"
  296.   DEFTEXT 1,1,0,6
  297.   IF pjgrez%=2
  298.     DEFTEXT 1,1,0,13
  299.   ENDIF
  300.   TEXT 25,72*pjgrez%,"Daron Brewood @ FidoNet....2:255/401.0 "
  301.   TEXT 25,80*pjgrez%,"                NeST.......90:1/0.0    "
  302.   TEXT 25,88*pjgrez%,"                MysticNet..69:200/102.0"
  303.   TEXT 25,96*pjgrez%,"                ChristNet..12:1001/0.0"
  304.   TEXT 25,106*pjgrez%,"  Phil Gadsby @ FidoNet....2:255/400.0"
  305.   TEXT 25,114*pjgrez%,"                NeST.......90:1040/0.0"
  306.   TEXT 25,122*pjgrez%,"                MysticNet..69:200/103.0"
  307.   TEXT 25,130*pjgrez%,"                ClariNet...11:9200/100.0"
  308.   DEFTEXT 1,24,0,13
  309.   TEXT 90,54*pjgrez%,note$
  310.   DEFTEXT 1,0,0,4
  311.   nest_picture
  312.   DEFTEXT 1,0,0,13
  313.   IF pjgrez%=1
  314.     DEFTEXT 1,0,0,6
  315.   ENDIF
  316. RETURN
  317. > PROCEDURE key
  318.   pro$="key"
  319.   IF test#
  320.     PRINT
  321.     PRINT " O = Outgoing Call    I = Incoming call      F = File Request    S = Send Mail"
  322.     PRINT " R = Receive Mail     ! = Session Aborted    Q = File Request Limit Exceeded"
  323.     PRINT " C = Compressed Mail  L = Lost Carrier       ? = Called X and got Y"
  324.     PRINT " P = Password Protected Session              X = Password Error"
  325.     PRINT " Z = Zmodem Recv Problem                     D = Other End Died"
  326.     PRINT " E = Remote Didn't Respond                   $ = Connection Attempt Aborted"
  327.     PRINT " # = Outgoing Poll    N = No Carrier         + = Bad Line Connection"
  328.   ENDIF
  329.   PRINT #2,""
  330.   PRINT #2," O = Outgoing Call    I = Incoming call      F = File Request    S = Send Mail"
  331.   PRINT #2," R = Receive Mail     ! = Session Aborted    Q = File Request Limit Exceeded"
  332.   PRINT #2," C = Compressed Mail  L = Lost Carrier       ? = Called X and got Y"
  333.   PRINT #2," P = Password Protected Session              X = Password Error"
  334.   PRINT #2," Z = Zmodem Recv Problem                     D = Other End Died"
  335.   PRINT #2," E = Remote Didn't Respond                   $ = Connection Attempt Aborted"
  336.   PRINT #2," # = Outgoing Poll    N = No Carrier         + = Bad Line Connection"
  337.   PRINT #2
  338.   PRINT #2,note$
  339.   PRINT #3
  340.   PRINT #3,note$
  341. RETURN
  342. > PROCEDURE scan
  343.   pro$="scan"
  344.   processing#=INSTR(bink_line$,"Processing node")>1
  345.   IF INSTR(UPPER$(bink_line$),"POLL COMPLETED")<>0
  346.     pollcomp#=1
  347.   ENDIF
  348.   IF INSTR(UPPER$(bink_line$),"INCOMING CALL, DIAL ABORTED")<>0
  349.     pollcomp#=1
  350.   ENDIF
  351.   IF INSTR(UPPER$(bink_line$),"DIALING") ! AND new_bbs=0
  352.     call$="O"
  353.     new_bbs#=1
  354.   ENDIF
  355.   IF INSTR(UPPER$(bink_line$),"ENTERING POLL MODE") AND new_bbs#=0
  356.     call$="#"
  357.     pass$="-"
  358.     new_bbs#=1
  359.   ENDIF
  360.   '
  361.   '
  362.   IF INSTR(bink_line$,"-|-")>=1 OR INSTR(bink_line$,"|")
  363.     IF test#
  364.       PRINT bink_line$
  365.     ENDIF
  366.     PRINT #3,bink_line$
  367.   ENDIF
  368.   '
  369.   '
  370.   IF INSTR(UPPER$(bink_line$),"SENDING MAIL FOR") AND gotit%=0
  371.     node$=MID$(bink_line$,41)
  372.     strip
  373.     node$="("+node$+")"
  374.     x_node$=node$
  375.     '        PRINT x_node$
  376.     gotit%=1
  377.   ENDIF
  378.   '
  379.   IF INSTR(UPPER$(bink_line$),"SENDING MAIL USING FTS-0001") AND gotit%=0
  380.     gotit%=1
  381.     ftsc%=1
  382.   ENDIF
  383.   '
  384.   IF INSTR(UPPER$(bink_line$),"(") AND INSTR(UPPER$(bink_line$),":") AND ftsc%=1
  385.     node$=MID$(bink_line$,41)
  386.     strip
  387.     x_node$=node$
  388.     '        PRINT x_node$
  389.     gotit%=1
  390.   ENDIF
  391.   '
  392.   '
  393.   ' flag code moved to here to ensure it works properly.
  394.   '
  395.   IF INSTR(UPPER$(bink_line$),"RECEIVED")
  396.     mess_stat$=mess_stat$+"R"
  397.   ENDIF
  398.   IF INSTR(UPPER$(bink_line$),"SENT")>=1
  399.     mess_stat$=mess_stat$+"S"
  400.   ENDIF
  401.   IF INSTR(UPPER$(bink_line$),"ZMODEM RECV PROBLEM")>=1
  402.     mess_stat$=mess_stat$+"Z"
  403.   ENDIF
  404.   IF INSTR(UPPER$(bink_line$),"OTHER END DIED")>=1
  405.     mess_stat$=mess_stat$+"D"
  406.   ENDIF
  407.   IF INSTR(UPPER$(bink_line$),"REMOTE DIDN'T RESPOND")>=1
  408.     mess_stat$=mess_stat$+"E"
  409.   ENDIF
  410.   IF INSTR(UPPER$(bink_line$),"FILE REQUEST (")>=1
  411.     mess_stat$=mess_stat$+"F"
  412.   ENDIF
  413.   IF INSTR(UPPER$(bink_line$),"FILE REQUEST LIMIT EXCEEDED")>=1
  414.     mess_stat$=mess_stat$+"Q"
  415.   ENDIF
  416.   IF INSTR(UPPER$(bink_line$),"SESSION ABORTED")>=1
  417.     mess_stat$=mess_stat$+"!"
  418.   ENDIF
  419.   IF INSTR(UPPER$(bink_line$),"CONNECTION ATTEMPT ABORTED")>=1
  420.     mess_stat$=mess_stat$+"$"
  421.   ENDIF
  422.   IF INSTR(UPPER$(bink_line$),"AND GOT")>=1 AND INSTR(UPPER$(bink_line$),"CALLED")>=1
  423.     mess_stat$=mess_stat$+"?"
  424.   ENDIF
  425.   IF INSTR(UPPER$(bink_line$),"ZEDZAP")
  426.     xfer$="ZedZap"
  427.   ENDIF
  428.   IF INSTR(UPPER$(bink_line$),"JANUS")
  429.     xfer$="Janus"
  430.   ENDIF
  431.   '
  432.   IF INSTR(UPPER$(bink_line$),"EMSI")
  433.     xfer$="EMSI"
  434.   ENDIF
  435.   IF INSTR(UPPER$(bink_line$),"FTS-0001")
  436.     xfer$="FTS-1"
  437.     sysop$="FTS-0001 - Unknown"
  438.   ENDIF
  439.   '
  440.   IF INSTR(UPPER$(bink_line$),"PASSWORD-PROTECTED SESSION")
  441.     pass$="P"
  442.   ENDIF
  443.   IF INSTR(UPPER$(bink_line$),"PASSWORD ERROR")
  444.     pass$="X"
  445.   ENDIF
  446.   '
  447.   IF processing# AND test#
  448.     PRINT bink_line$
  449.   ENDIF
  450.   IF INSTR(UPPER$(bink_line$),"END ")>=1 AND new_bbs#=1 OR pollcomp#=1 OR processing#=1
  451.     tock$=MID$(bink_line$,10,5)
  452.     bink_line$=UPPER$(bink_line$)
  453.     IF INSTR(bink_line$,"END OF EMSI")
  454.       tock$=MID$(bink_line$,10,5)
  455.     ENDIF
  456.     IF INSTR(bink_line$,"END OF FTS-0001")
  457.       tock$=MID$(bink_line$,10,5)
  458.     ENDIF
  459.     IF xfer$<>"" OR processing#
  460.     crab:
  461.       IF LEN(node$)>20
  462.         node$="(Address Error)"
  463.       ENDIF
  464.       IF INSTR(mess_stat$,"S")>=1
  465.         daron$=daron$+"S"
  466.       ENDIF
  467.       IF INSTR(mess_stat$,"R")>=1
  468.         daron$=daron$+"R"
  469.       ENDIF
  470.       IF INSTR(mess_stat$,"F")>=1
  471.         daron$=daron$+"F"
  472.       ENDIF
  473.       IF INSTR(mess_stat$,"Q")>=1
  474.         daron$=daron$+"Q"
  475.       ENDIF
  476.       IF INSTR(mess_stat$,"C")>=1
  477.         daron$=daron$+"C"
  478.       ENDIF
  479.       IF INSTR(mess_stat$,"L")>=1
  480.         daron$=daron$+"L"
  481.       ENDIF
  482.       IF INSTR(mess_stat$,"X")>=1
  483.         daron$=daron$+"X"
  484.       ENDIF
  485.       IF INSTR(mess_stat$,"?")>=1
  486.         daron$=daron$+"?"
  487.       ENDIF
  488.       IF INSTR(mess_stat$,"!")>=1
  489.         daron$=daron$+"!"
  490.       ENDIF
  491.       IF INSTR(mess_stat$,"Z")>=1
  492.         daron$=daron$+"Z"
  493.       ENDIF
  494.       IF INSTR(mess_stat$,"D")>=1
  495.         daron$=daron$+"D"
  496.       ENDIF
  497.       IF INSTR(mess_stat$,"E")>=1
  498.         daron$=daron$+"E"
  499.       ENDIF
  500.       IF INSTR(mess_stat$,"$")>=1
  501.         daron$=daron$+"$"
  502.       ENDIF
  503.       IF INSTR(mess_stat$,"N")>=1
  504.         daron$=daron$+"N"
  505.       ENDIF
  506.       IF INSTR(mess_stat$,"+")>=1
  507.         daron$=daron$+"+"
  508.       ENDIF
  509.       '      IF INSTR(UPPER$(bink_line$),"SENDING MAIL FOR")
  510.       '     node$=MID$(bink_line$,41)
  511.       '    strip
  512.       '   node$="("+node$+")"
  513.       '  x_node$=node$
  514.       ' '        PRINT x_node$
  515.       ' ENDIF
  516.       IF tick$<>""
  517.         IF LEN(node$)>20
  518.           node$=LEFT$(node$,20)
  519.         ENDIF
  520.         IF LEN(sysop$)>20
  521.           sysop$=LEFT$(sysop$,20)
  522.         ENDIF
  523.         IF LEN(xfer$)>8
  524.           xfer$=LEFT$(xfer$,8)
  525.         ENDIF
  526.         pprint$=" "+tick$+"  "+tock$+"  "+node$+SPACE$(20-LEN(node$))+sysop$+SPACE$(20-LEN(sysop$))+xfer$+SPACE$(8-LEN(xfer$))+freq$+pass$+call$+"|"+daron$
  527.         ' PRINT LEN(pprint$)
  528.         PRINT pprint$
  529.         gotit%=0
  530.         ftsc%=0
  531.         show_it
  532.         create_key
  533.       ENDIF
  534.     ENDIF
  535.     x_node$=""
  536.     pollcomp#=0
  537.     new_bbs#=0
  538.     IF INSTR(pprint$,":") AND tick$<>""
  539.       PRINT #2,pprint$
  540.       IF test# THEN
  541.         PRINT pprint$
  542.       ENDIF
  543.     ENDIF
  544.     set_var
  545.   ENDIF
  546.   slash#=INSTR(bink_line$,"/")>1
  547.   colon#=INSTR(bink_line$,":")>1
  548.   open_bracket#=INSTR(bink_line$,"(")>1
  549.   '
  550.   ads%=INSTR(UPPER$(bink_line$),"ADDRESS:")
  551.   IF ads%>=1 AND x_node$=""
  552.     x_node$="("+MID$(bink_line$,ads%+9)+")"
  553.     x_node$=TRIM$(x_node$)
  554.     node$=x_node$
  555.     strip
  556.     x_node$=node$
  557.   ENDIF
  558.   sys%=INSTR(UPPER$(bink_line$),"SYSOP:")
  559.   IF sys%
  560.     sysop$=MID$(bink_line$,sys%+7)
  561.     sysop$=TRIM$(sysop$)
  562.   ENDIF
  563.   '
  564.   IF (slash# AND colon# AND open_bracket#)
  565.     change_date
  566.     new_bbs#=1
  567.     tick$=MID$(bink_line$,3,12)
  568.   woops:
  569.     IF test#
  570.       PRINT "woops"
  571.     ENDIF
  572.     brkt_pos#=INSTR(bink_line$,"(")
  573.     node$=MID$(bink_line$,brkt_pos#)
  574.     IF processing#>0
  575.       node$=MID$(bink_line$,processing#+41)
  576.       tear#=INSTR(node$," --")
  577.       IF test#
  578.         PRINT node$
  579.       ENDIF
  580.       node$=LEFT$(node$,tear#-1)
  581.       IF test#
  582.         PRINT node$
  583.       ENDIF
  584.       node$="("+node$+")"
  585.       '
  586.       IF test#
  587.         PRINT node$
  588.         PRINT bink_line$
  589.         PRINT "tear ";tear#
  590.       ENDIF
  591.       tear#=RINSTR(bink_line$,"-- ")
  592.       IF test#
  593.         PRINT "tear 2 ";tear#
  594.       ENDIF
  595.       '      sysop$=MID$(bink_line$,tear#+3)
  596.       IF LEN(sysop$)>19
  597.         sysop$=RIGHT$(sysop$,19)
  598.       ENDIF
  599.       xfer$="-"
  600.       IF test#
  601.         PRINT "sysops$>";sysop$;"< LEN sysop$ ";LEN(sysop$)
  602.       ENDIF
  603.     ENDIF
  604.     IF INSTR(node$,":")>5
  605.       bink_line$=MID$(bink_line$,brkt_pos#+1)
  606.       GOTO woops
  607.     ENDIF
  608.     node$=LEFT$(node$,INSTR(node$,")"))
  609.     strip
  610.   ENDIF
  611.   IF INSTR(node$,":")=0
  612.     node$=x_node$
  613.     strip
  614.   ENDIF
  615.   IF new_bbs#=1 OR processing#
  616.     '
  617.     ' flag test code was her ein older versions before 1.49
  618.     '
  619.     IF INSTR(bink_line$,"Sysop:")
  620.       sysop$=MID$(bink_line$,INSTR(bink_line$,"Sysop:")+7)
  621.     ENDIF
  622.     IF INSTR(UPPER$(bink_line$),"LOST CARRIER")>=1
  623.       mess_stat$=mess_stat$+"L"
  624.     ENDIF
  625.     IF INSTR(UPPER$(bink_line$),"NO CARRIER")>=1
  626.       mess_stat$=mess_stat$+"N"
  627.     ENDIF
  628.     IF INSTR(UPPER$(bink_line$),"REMOTE SYNC")>=1 OR INSTR(UPPER$(bink_line$),"SAVING PARTIAL")>=1
  629.       mess_stat$=mess_stat$+"+"
  630.     ENDIF
  631.   ENDIF
  632.   '
  633.   IF INSTR(UPPER$(bink_line$),"EXIT AFTER COMPRESSED MAIL")>=1
  634.     mess_stat$=mess_stat$+"C"
  635.   ENDIF
  636.   IF INSTR(UPPER$(bink_line$),"EXITING TO EXTERNAL MAILER")>=1
  637.     mess_stat$=mess_stat$+"K"
  638.   ENDIF
  639. RETURN
  640. > PROCEDURE cleanup
  641.   PRINT "Error found...... Check FSCAN.ERR file."
  642.   CLOSE
  643.   IF EXIST("fscan.err")
  644.     OPEN "a",#1,"fscan.err"
  645.   ELSE
  646.     OPEN "o",#1,"fscan.err"
  647.   ENDIF
  648.   PRINT #1
  649.   PRINT #1,"**ERROR**"
  650.   PRINT #1,"Error is number: ";+ERR
  651.   PRINT #1,"Error is: "+ERR$(ERR)
  652.   PRINT #1,"Error is in Routine, or is: '"+pro$+"'."
  653.   PRINT #1,"Error took place at: "+TIME$+" on "+DATE$+"."
  654.   PRINT #1,line$
  655.   CLOSE
  656.   CLS
  657.   PRINT "**ERROR**"
  658.   PRINT "Error is number: ";ERR
  659.   PRINT "Error is: ";ERR$(ERR)
  660.   PRINT "Error is in Routine, or is: '";pro$;"'."
  661.   PAUSE 100
  662.   END
  663. RETURN
  664. > PROCEDURE shutdown
  665.   CLOSE
  666.   CLOSEW 0
  667.   END
  668. RETURN
  669. > PROCEDURE set_mask
  670.   pro$="set mask"
  671.   RESTORE mask
  672.   READ punt#
  673.   DIM mask$(punt#)
  674.   FOR t#=1 TO punt#
  675.     READ mask$(t#)
  676.     mask$(t#)=UPPER$(mask$(t#))
  677.   NEXT t#
  678. RETURN
  679. > PROCEDURE strip
  680.   pro$="strip(address$)"
  681.   node$=UPPER$(node$)
  682.   FOR eek#=1 TO punt#
  683.     post#=INSTR(node$,mask$(eek#))
  684.     IF post#>0
  685.       cut_it
  686.     ENDIF
  687.   NEXT eek#
  688. RETURN
  689. > PROCEDURE cut_it
  690.   pro$="cut it"
  691.   node_left$=LEFT$(node$,post#-1)
  692.   node_right$=MID$(node$,post#+LEN(mask$(eek#)))
  693.   node$=node_left$+node_right$
  694.   node$=TRIM$(node$)
  695. RETURN
  696. > PROCEDURE create_key
  697.   pro$="create key"
  698.   key$=MID$(node$,2)
  699.   IF INSTR(node$,":")
  700.     pos_colon#=INSTR(key$,":")
  701.     pos_slash#=INSTR(key$,"/")
  702.     pos_point#=INSTR(key$,".")
  703.     key_zone$=LEFT$(key$,pos_colon#-1)
  704.     key_zone#=VAL(key_zone$)
  705.     key_zone$=STR$(key_zone#,8)
  706.     key_net$=MID$(key$,pos_colon#+1,pos_slash#-pos_colon#-1)
  707.     key_net#=VAL(key_net$)
  708.     key_net$=STR$(key_net#,8)
  709.     IF pos_point#<>0
  710.       key_node$=MID$(key$,pos_slash#+1,pos_point#-pos_slash#-1)
  711.     ELSE
  712.       key_node$=MID$(key$,pos_slash#+1)
  713.     ENDIF
  714.     key_node#=VAL(key_node$)
  715.     key_node$=STR$(key_node#,8)
  716.     IF pos_point#<>0
  717.       key_point$=MID$(key$,pos_point#+1)
  718.       key_point#=VAL(key_point$)
  719.     ELSE
  720.       key_point#=0
  721.     ENDIF
  722.     key_point$=STR$(key_point#,8)
  723.     key$=key_zone$+key_net$+key_node$+key_point$
  724.     IF test#
  725.       PRINT "key$= ";key$
  726.     ENDIF
  727.     PRINT #4,key$
  728.     IF test#
  729.       PRINT AT(14,16);">>>>>>>>> ";key$;" <<<<<<<<<<"
  730.     ENDIF
  731.   ENDIF
  732. RETURN
  733. > PROCEDURE barchart
  734.   CLS
  735.   PRINT "Creating barchart."
  736.   pro$="barchart"
  737.   day#=mark#
  738.   show_it
  739.   read_date_data
  740.   show_it
  741.   create_master_index
  742.   show_it
  743.   sort_index
  744.   show_it
  745.   create_array_map
  746.   show_it
  747.   put_array_into_screen
  748. RETURN
  749. > PROCEDURE read_date_data
  750.   pro$="read date data"
  751.   FOR dayt#=1 TO day#
  752.     file$=store$+"FSCAN."+STR$(dayt#)
  753.     IF EXIST(file$)
  754.       read_day
  755.     ELSE
  756.       IF test#
  757.         PRINT file$;" Not found.."
  758.       ENDIF
  759.     ENDIF
  760.   NEXT dayt#
  761. RETURN
  762. > PROCEDURE read_day
  763.   pro$="read day"
  764.   IF test#
  765.     PRINT "Day = ";dayt#
  766.   ENDIF
  767.   OPEN "i",#1,file$
  768.   WHILE NOT EOF(#1)
  769.     INC adr#(dayt#)
  770.     IF adr#(dayt#)>adr_max#
  771.       adr_max#=adr#(dayt#)
  772.     ENDIF
  773.     LINE INPUT #1,day_ad$(dayt#,adr#(dayt#))
  774.     IF test#
  775.       PRINT "Day_ad$(dayt,adr(dayt)= ";day_ad$(dayt#,adr#(dayt#))
  776.     ENDIF
  777.   WEND
  778.   adr#(dayt#)=0
  779.   CLOSE #1
  780. RETURN
  781. > PROCEDURE create_master_index
  782.   pro$="create master index"
  783.   FOR file#=1 TO day#
  784.     FOR node#=1 TO adr_max#
  785.       IF LEN(day_ad$(file#,node#))>10
  786.         INC master_pointer#
  787.         master_index$(master_pointer#)=day_ad$(file#,node#)
  788.         IF test#
  789.           PRINT "Master Index: ";master_index$(master_pointer%);" Day: ";day#;"Adr_max: ";adr_max#
  790.         ENDIF
  791.         FOR dmb#=1 TO master_pointer#-1
  792.           IF day_ad$(file#,node#)=master_index$(dmb#)
  793.             DEC master_pointer#
  794.           ENDIF
  795.         NEXT dmb#
  796.       ENDIF
  797.     NEXT node#
  798.   NEXT file#
  799.   IF test#
  800.     PRINT "Master pointer at: ";master_pointer#
  801.   ENDIF
  802. RETURN
  803. > PROCEDURE sort_index
  804.   PRINT "Sorting index."
  805.   pro$="sort index"
  806.   QSORT master_index$(+),master_pointer#+1
  807. RETURN
  808. > PROCEDURE create_array_map
  809.   PRINT "Creating array map.";
  810.   pro$="create array map"
  811.   FOR call#=1 TO day#
  812.     PRINT ".";
  813.     IF call#/2=INT(call#/2)
  814.       show_it
  815.     ENDIF
  816.     IF test#
  817.       PRINT call#
  818.     ENDIF
  819.     FOR node#=1 TO adr_max#
  820.       FOR check3#=1 TO master_pointer#
  821.         IF master_index$(check3#)=day_ad$(call#,node#)
  822.           map$(call#,check3#)="*"
  823.           IF check3#>check_max#
  824.             check_max#=check3#
  825.           ENDIF
  826.         ENDIF
  827.       NEXT check3#
  828.     NEXT node#
  829.   NEXT call#
  830.   PRINT
  831. RETURN
  832. > PROCEDURE put_array_into_screen
  833.   PRINT "Putting array into screen."
  834.   pro$="put array into screen"
  835.   width#=75
  836.   DIM xscreen$(width#,check_max#+50)
  837.   FOR q#=1 TO width#
  838.     FOR w#=1 TO check_max#+50
  839.       xscreen$(q#,w#)=" "
  840.     NEXT w#
  841.   NEXT q#
  842.   IF test#
  843.     CLS
  844.   ENDIF
  845.   get_month
  846.   xwrite_scr("Zone",5,4)
  847.   xwrite_scr("----",5,5)
  848.   xwrite_scr("Net",14,4)
  849.   xwrite_scr("---",14,5)
  850.   xwrite_scr("Node",21,4)
  851.   xwrite_scr("----",21,5)
  852.   xwrite_scr("Point",32,4)
  853.   xwrite_scr("-----",32,5)
  854.   xwrite_scr("Month / Year: "+month$+" "+MID$(DATE$,7,4),5,2)
  855.   ' IF test#
  856.   '  CLS
  857.   PRINT "Building map."
  858.   ' ENDIF
  859.   FOR x#=1 TO day#
  860.     FOR y#=1 TO master_pointer# ! check_max
  861.       IF test#
  862.         PRINT ".";
  863.       ENDIF
  864.       xwrite_scr(master_index$(y#),1,y#+5)
  865.       x$=RIGHT$(STR$(x#),1)
  866.       y$=LEFT$(STR$(x#,2),1)
  867.       xscreen$(x#+40,3)=y$
  868.       xscreen$(x#+40,4)=x$
  869.       xscreen$(x#+40,5)="-"
  870.       xscreen$(40,5)="+"
  871.       xscreen$(40,y#+5)="|"
  872.       IF map$(x#,y#)<>"*"
  873.         map$(x#,y#)=" "
  874.       ENDIF
  875.       xscreen$(x#+40,y#+5)=map$(x#,y#)
  876.     NEXT y#
  877.   NEXT x#
  878.   print_screen$=""
  879.   title1$="  F-Scan "+ver$+". Barchart of Binkley Mail Activity. © D.M.Brewood, 1990,91,92."
  880.   title2$="     FidoNet: 2:255/401.0  NeST: 90:1/0.0"
  881.   OPEN "o",#2,barchart$
  882.   PRINT #2,""
  883.   PRINT #2,title1$
  884.   PRINT #2,title2$
  885.   IF test#
  886.     PRINT
  887.     PRINT title1$
  888.     PRINT title2$
  889.   ENDIF
  890.   FOR a#=1 TO master_pointer#+5 !check_max
  891.     FOR b#=1 TO width#
  892.       print_screen$=print_screen$+xscreen$(b#,a#)
  893.     NEXT b#
  894.     PRINT #2,print_screen$
  895.     IF test#
  896.       '      PRINT ">";print_screen$;"<"
  897.     ENDIF
  898.     print_screen$=""
  899.   NEXT a#
  900.   IF test#
  901.     PRINT #2
  902.     PRINT #2,note$
  903.   ENDIF
  904.   CLOSE #2
  905. RETURN
  906. > PROCEDURE xwrite_scr(text_to_write$,position_x#,position_y#)
  907.   pro$="xwrite_scr(text_to_write$,position_x,position_y)"
  908.   we#=LEN(text_to_write$)
  909.   FOR qw#=1 TO we#
  910.     xscreen$(position_x#+qw#,position_y#)=MID$(text_to_write$,qw#,1)
  911.   NEXT qw#
  912. RETURN
  913. > PROCEDURE barsum
  914.   pro$="barsum"
  915.   checkpoint$="bardate.fcn"
  916.   IF EXIST(checkpoint$)
  917.     check_checkpoint              !Checks to see if as$ changes.
  918.   ELSE
  919.     '    make_barchart_backup !line REMmed out anyway.
  920.     create_checkpoint
  921.   ENDIF
  922.   IF VAL(as$)<>VAL(MID$(DATE$,4,2))
  923.     '    make_barchart_backup !REMmed out to stop barchart being made
  924.     create_checkpoint
  925.   ENDIF
  926. RETURN
  927. > PROCEDURE check_checkpoint
  928.   pro$="check checkpoint"
  929.   OPEN "i",#3,checkpoint$
  930.   LINE INPUT #3,as$
  931.   CLOSE #3
  932. RETURN
  933. > PROCEDURE wread_write_barchart_backup
  934.   pro$="wread write barchart backup"
  935.   IF EXIST(barchart$)
  936.     OPEN "i",#2,barchart$
  937.     FOR x#=1 TO 4
  938.       LINE INPUT #2,dummy$
  939.     NEXT x#
  940.     REPEAT
  941.       LINE INPUT #2,readir$
  942.       PRINT #5,readir$
  943.       IF test#
  944.         PRINT readir$
  945.       ENDIF
  946.     UNTIL EOF(#2)
  947.     CLOSE #2
  948.   ENDIF
  949. RETURN
  950. > PROCEDURE get_month
  951.   pro$="get month"
  952.   a#=VAL(MID$(DATE$,4,2))
  953.   SELECT a#
  954.   CASE 1
  955.     month$="January"
  956.   CASE 2
  957.     month$="February"
  958.   CASE 3
  959.     month$="March"
  960.   CASE 4
  961.     month$="April"
  962.   CASE 5
  963.     month$="May"
  964.   CASE 6
  965.     month$="June"
  966.   CASE 7
  967.     month$="july"
  968.   CASE 8
  969.     month$="August"
  970.   CASE 9
  971.     month$="September"
  972.   CASE 10
  973.     month$="October"
  974.   CASE 11
  975.     month$="November"
  976.   CASE 12
  977.     month$="December"
  978.   ENDSELECT
  979. RETURN
  980. > PROCEDURE title_barchart
  981.   pro$="title barchart"
  982.   title1$="     F-Scan "+ver$+". Summary of Binkley Mail Activity. (C) D.M.Brewood, 1990,91."
  983.   title2$="     FidoNet: 2:255/401.0  NeST: 90:1/0.0"
  984.   PRINT #5,title1$
  985.   PRINT #5,title2$
  986.   PRINT #5
  987. RETURN
  988. > PROCEDURE create_checkpoint
  989.   pro$="create checkpoint"
  990.   OPEN "o",#3,checkpoint$
  991.   as$=MID$(DATE$,4,2)
  992.   PRINT #3,as$
  993.   CLOSE #3
  994. RETURN
  995. > PROCEDURE make_barchart_backup
  996.   pro$="make barchart backup"
  997.   IF EXIST(barsum$)
  998.     OPEN "a",#5,barsum$
  999.   ELSE
  1000.     OPEN "o",#5,barsum$
  1001.     title_barchart
  1002.   ENDIF
  1003.   wread_write_barchart_backup
  1004.   CLOSE #5
  1005. RETURN
  1006. > PROCEDURE notify_reg
  1007.   pro$="notify reg"
  1008.   IF EXIST(store$+"FSCAN_U.NOT")
  1009.     OPEN "i",#5,store$+"FSCAN_U.NOT"
  1010.     LINE INPUT #5,ck$
  1011.     CLOSE #5
  1012.   ENDIF
  1013.   IF ck$=ver$
  1014.     IF test#
  1015.       PRINT "Program is latest version."
  1016.     ENDIF
  1017.     notice%=1
  1018.     '    notice=0
  1019.   ELSE
  1020.     IF test#
  1021.       PRINT "Sending notification of upgrade to version ";ver$;"."
  1022.     ENDIF
  1023.   ENDIF
  1024.   IF notice%<>1
  1025.     IF EXIST(cfg_file$)
  1026.       IF test#
  1027.         PRINT "F-Scan Notice of useage sent.."
  1028.       ENDIF
  1029.       reg_loop
  1030.       make_tic
  1031.       xsave_notification
  1032.     ELSE
  1033.       PRINT UPPER$(cfg_file$);" Not found.... check FIDOCALL.DAT"
  1034.       PAUSE 100
  1035.       END
  1036.     ENDIF
  1037.   ENDIF
  1038. RETURN
  1039. > PROCEDURE xsave_notification
  1040.   OPEN "o",#5,store$+"FSCAN_U.NOT"
  1041.   PRINT #5,ver$
  1042.   PRINT #5,"F-Scan notice of useage sent on "+DATE$+"."
  1043.   CLOSE #5
  1044. RETURN
  1045. > PROCEDURE reg_loop
  1046.   pro$="reg loop"
  1047.   OPEN "I",#5,cfg_file$
  1048.   REPEAT
  1049.     LINE INPUT #5,line$
  1050.     line$=UPPER$(line$)
  1051.     line$=TRIM$(line$)
  1052.     scan_it
  1053.   UNTIL EOF(#5)
  1054.   CLOSE #5
  1055. RETURN
  1056. > PROCEDURE make_tic
  1057.   pro$="make tic"
  1058.   add_check
  1059.   IF key_check%=1
  1060.     keyadd$="Valid Key in Use with this program"
  1061.   ELSE
  1062.     keyadd$="This program is being used without a Key, expect a key request soon"
  1063.   ENDIF
  1064.   from$="From  : "+xaddress$(1)
  1065.   sysop$=RIGHT$(sysop$,LEN(sysop$)-5)
  1066.   sysop$=TRIM$(sysop$)
  1067.   pgsysop$=sysop$
  1068.   sysop$="SysOp : "+sysop$
  1069.   system$=MID$(system$,INSTR(system$," ")+1)
  1070.   system$=TRIM$(system$)
  1071.   system$="System: "+system$
  1072.   desc$="Notice: F-Scan Notice of use from node "+xaddress$(1)+" on "+DATE$+"."
  1073.   created$="Info  : Created by F-Scan v"+ver$+" ©1990/91/92 Daron Brewood 2:255/401.0"
  1074.   path$="Path  : "+xaddress$(1)
  1075.   FOR x%=2 TO xaddr_pointer%
  1076.     seenby$(x%)="AKA   : "+xaddress$(x%)
  1077.   NEXT x%
  1078.   '  IF INSTR(xaddress$(1),coder_address$)<1
  1079.   msg$=msg$+from$+CHR$(10)+sysop$+CHR$(10)+system$+CHR$(10)
  1080.   msg$=msg$+desc$+CHR$(10)+created$+CHR$(10)+path$+CHR$(10)
  1081.   FOR x%=2 TO xaddr_pointer%
  1082.     seenby$(x%)=TRIM$(seenby$(x%))
  1083.     msg$=msg$+seenby$(x%)+CHR$(10)
  1084.   NEXT x%
  1085.   msg$=msg$+CHR$(10)+CHR$(10)+keyadd$+CHR$(10)
  1086.   CLOSE #5
  1087.   netmail_write
  1088.   ' ELSE
  1089.   '  PRINT "Hi Daron, Upgraded your version then!"
  1090.   '
  1091.   ' ENDIF
  1092. RETURN
  1093. > PROCEDURE add_check
  1094.   FOR x%=1 TO xaddr_pointer%
  1095.     IF INSTR(xaddress$(x%),"100:")
  1096.       IF key_check%<>1
  1097.         PRINT
  1098.         PRINT " F-Scan detects a TurboNet '100:' address in your config files. This program"
  1099.         PRINT " will not operate  on your system without a registration fee being paid to:"
  1100.         PRINT "    Daron Brewood @ 2:255/401.0@fidonet.org   90:1/0.0@nest.ftn"
  1101.         PRINT "    Phil Gadsby   @ 2:255/400.0@fidonet.org   90:1040/0.0@nest.ftn"
  1102.         PAUSE 200
  1103.         CLS
  1104.         END
  1105.       ELSE
  1106.         good%=2
  1107.       ENDIF
  1108.     ENDIF
  1109.   NEXT x%
  1110. RETURN
  1111. > PROCEDURE check_sysop
  1112.   ' Called from Netmail_Write
  1113.   RESTORE bad
  1114.   READ bad_sysop%
  1115.   DIM bad_sys$(bad_sysop%)
  1116.   clean%=0
  1117.   FOR x%=1 TO bad_sysop%
  1118.     READ bad_sysop$
  1119.     bad_sys$(x%)=bad_sysop$
  1120.   NEXT x%
  1121.   FOR x%=1 TO bad_sysop%
  1122.     bad_sysop$=bad_sys$(x%)
  1123.     '    test_good
  1124.     IF INSTR(UPPER$(pgsysop$),UPPER$(bad_sysop$)) AND key_check%=0
  1125.       PRINT
  1126.       PRINT " F-Scan recognises you as 'unregistered' and will not operate"
  1127.       PRINT " on your system. By order of:"
  1128.       PRINT "    Daron Brewood @ 2:255/401.0@fidonet.org   90:1/0.0@nest.ftn"
  1129.       PRINT "    Phil Gadsby   @ 2:255/400.0@fidonet.org   90:1040/0.0@nest.ftn"
  1130.       PAUSE 200
  1131.       CLOSE
  1132.       CLS
  1133.       END
  1134.     ENDIF
  1135.   NEXT x%
  1136.   PRINT
  1137.   PRINT "F-Scan approves of your system.... nice gear!"
  1138.   PRINT
  1139. RETURN
  1140. > PROCEDURE test_good
  1141.   ' RESTORE good
  1142.   ' READ qty
  1143.   ' FOR y=1 TO qty
  1144.   ' READ good_sysop$
  1145.   ' IF INSTR(UPPER$(pgsysop$),UPPER$(good_sysop$))
  1146.   ' good=1
  1147.   ' ENDIF
  1148.   ' NEXT y
  1149. RETURN
  1150. > PROCEDURE send_reg
  1151.   pro$="send reg"
  1152.   make_tic
  1153. RETURN
  1154. > PROCEDURE scan_it
  1155.   pro$="scan it"
  1156.   IF LEFT$(line$,1)<>";" AND INSTR(line$,"APPLICATION")<=0
  1157.     IF INSTR(line$,"ADDRESS")>=1 AND INSTR(line$,":")>1
  1158.       ' line below removed to get rid of spurious ADDRESS messages.
  1159.       ' PRINT line$
  1160.       '
  1161.       line$=MID$(line$,8)
  1162.       '      PRINT line$;"<"
  1163.       '
  1164.       IF test#
  1165.         PRINT "line$ ";line$
  1166.       ENDIF
  1167.       line$=TRIM$(line$)
  1168.       IF INSTR(line$,":")>0
  1169.         INC xaddr_pointer%
  1170.       ENDIF
  1171.       xaddress$(xaddr_pointer%)=line$
  1172.       '
  1173.       IF test#
  1174.         PRINT
  1175.         PRINT xaddress$(xaddr_pointer%);" ";xaddr_pointer%
  1176.         PRINT
  1177.       ENDIF
  1178.       at#=INSTR(xaddress$(xaddr_pointer%),"@")
  1179.       spac#=RINSTR(xaddress$(xaddr_pointer%)," ")
  1180.       IF test#
  1181.         PRINT " spac;";spac#
  1182.       ENDIF
  1183.       IF spac#>at#
  1184.         xaddress$(xaddr_pointer%)=LEFT$(xaddress$(xaddr_pointer%),spac#-1)
  1185.       ENDIF
  1186.       '
  1187.       colon%=LEN(xaddress$(xaddr_pointer%))-RINSTR(xaddress$(xaddr_pointer%),":")
  1188.       IF colon%>=1
  1189.         space%=LEN(xaddress$(xaddr_pointer%))-RINSTR(xaddress$(xaddr_pointer%)," ")
  1190.         xaddress$(xaddr_pointer%)=RIGHT$(xaddress$(xaddr_pointer%),colon%+(space%-colon%))
  1191.       ENDIF
  1192.       at%=INSTR(xaddress$(xaddr_pointer%),"@")
  1193.       IF at%=0
  1194.         at%=LEN(xaddress$(xaddr_pointer%))+1
  1195.       ENDIF
  1196.       xaddress$(xaddr_pointer%)=LEFT$(xaddress$(xaddr_pointer%),at%-1)
  1197.       xaddress$(xaddr_pointer%)=TRIM$(xaddress$(xaddr_pointer%))
  1198.       IF test#
  1199.         PRINT xaddress$(xaddr_pointer%);" < xaddress$(xaddr_pointer)"
  1200.       ENDIF
  1201.     ENDIF
  1202.     IF INSTR(line$,"HOLD")>=1
  1203.       hold$=line$
  1204.       IF RIGHT$(hold$,1)<>"\"
  1205.         hold$=hold$+"\"
  1206.       ENDIF
  1207.     ENDIF
  1208.     IF INSTR(line$,"NETFILE")>=1
  1209.       netfile$=line$
  1210.     ENDIF
  1211.     IF INSTR(line$,"SYSTEM")>=1
  1212.       system$=line$
  1213.     ENDIF
  1214.     IF INSTR(LEFT$(line$,6),"SYSOP")>=1
  1215.       sysop$=line$
  1216.     ENDIF
  1217.   ENDIF
  1218. RETURN
  1219. > PROCEDURE strip_hold
  1220.   pro$="strip hold"
  1221.   colon%=INSTR(hold$,":")
  1222.   hold$=MID$(hold$,colon%-1)
  1223.   slash%=RINSTR(hold$,"\")
  1224.   hold$=LEFT$(hold$,LEN(hold$)-(LEN(hold$)-slash%))
  1225. RETURN
  1226. > PROCEDURE netmail_write
  1227.   pro$="NetMail_Write"
  1228.   IF EXIST(netmail$+".HDR") AND EXIST(netmail$+".MSG") AND netmail$<>""
  1229.     ' PRINT "Found Netmail...."
  1230.     GOTO nm_open
  1231.   ELSE
  1232.     PRINT
  1233.     PRINT "Error Netmail Path Not Found, Should be Path & Filename without extension"
  1234.     PRINT "i.e.  D:\FIDO\MSGS\0000"
  1235.     PRINT
  1236.     PAUSE 100
  1237.     CLOSE
  1238.     END
  1239.   ENDIF
  1240. nm_open:
  1241.   pro$="NetMail OPen"
  1242.   OPEN "R",#50,netmail$+".HDR",216
  1243.   OPEN "A",#51,netmail$+".MSG"
  1244.   FOR balls%=1 TO 36
  1245.     fill$=fill$+CHR$(0)
  1246.   NEXT balls%
  1247.   offset%=LOF(#51)+1
  1248.   pro$="NetMail Field"
  1249.   FIELD #50,36 AS from$,36 AS to$,72 AS subject$,20 AS xtime$
  1250.   FIELD #50,4 AT(*stamp%),4 AT(*offset%),2 AT(*res&),2 AT(*rep&)
  1251.   FIELD #50,2 AT(*attr&),16 AS resmail$,2 AT(*m_size&),2 AT(*r_cnt&)
  1252.   FIELD #50,2 AT(*costx&),2 AT(*ozone&),2 AT(*onet&),2 AT(*onode&)
  1253.   FIELD #50,2 AT(*opoint&),2 AT(*dzone&),2 AT(*dnet&)
  1254.   FIELD #50,2 AT(*dnode&),2 AT(*dpoint&)
  1255.   pro$="NetMail calc"
  1256.   newer%=(LOF(#50)/216)+1
  1257.   from$=LEFT$(pgsysop$+fill$,36)
  1258.   check_sysop
  1259.   to$=LEFT$("Daron Brewood"+fill$,36)
  1260.   subject$=LEFT$("Notification Of Use for Fscan"+fill$+fill$,72)
  1261.   xtime$=LEFT$(TIME$+" "+DATE$+fill$,20)
  1262.   dzone&=2
  1263.   dnet&=255
  1264.   dnode&=401
  1265.   dpoint&=0
  1266.   pgnode$=xaddress$(1)
  1267.   IF INSTR(pgnode$,".")=0
  1268.     pgnode$=pgnode$+".0"
  1269.   ENDIF
  1270.   ozone&=VAL(LEFT$(pgnode$,INSTR(pgnode$,":")-1))
  1271.   onet&=VAL(MID$(pgnode$,INSTR(pgnode$,":")+1,INSTR(pgnode$,"/")-1))
  1272.   onode&=VAL(MID$(pgnode$,INSTR(pgnode$,"/")+1,INSTR(pgnode$,".")-1))
  1273.   opoint&=VAL(MID$(pgnode$,INSTR(pgnode$,".")+1))
  1274.   pro$="Netmail Node show"
  1275.   '  PRINT "From Node:-";ozone&,onet&,onode&,opoint&
  1276.   resmail$=LEFT$(fill$,16)
  1277.   attr&=way2go%
  1278.   stamp%=946080000            ! dont need acurate stamp, 30 years will do :-)
  1279.   mail$=CHR$(0)+CHR$(1)+"PID: FSCAN "+ver$+CHR$(10)
  1280.   mail$=mail$+msg$+CHR$(10)+CHR$(0)
  1281.   m_size&=LEN(mail$)
  1282.   ' works till here
  1283.   pro$="Netmail Put"
  1284.   PUT #50,newer%
  1285.   pro$="NetMail Print"
  1286.   PRINT #51,mail$
  1287.   CLOSE #50
  1288.   CLOSE #51
  1289.   pro$="End Of NetMail"
  1290. RETURN
  1291. > PROCEDURE sysop_reg
  1292.   max_sysop%=6
  1293.   DIM sys_reg$(max_sysop%)
  1294.   sys_reg$(1)=".......Fscan Processing......."
  1295.   sys_reg$(2)="Daron Brewood ................. FidoNet 2:255/401.0"
  1296.   sys_reg$(3)="Phil Gadsby ................... FidoNet 2:255/400.0"
  1297.   sys_reg$(4)="Alexander Bochmann ............ FidoNet 2:241/7042.0"
  1298.   sys_reg$(5)="Steve Pitt .................... FidoNet 2:255/403.0"
  1299.   sys_reg$(6)="David Thomas .................. FidoNet 2:253/600.0"
  1300. RETURN
  1301. > PROCEDURE show_it
  1302.   IF sysreg%<max_sysop%
  1303.     INC sysreg%
  1304.   ELSE
  1305.     sysreg%=1
  1306.   ENDIF
  1307.   IF sysreg%=1
  1308.     TITLEW #1,sys_reg$(sysreg%)
  1309.   ELSE
  1310.     TITLEW #1,"Registered SysOps: "+sys_reg$(sysreg%)
  1311.   ENDIF
  1312. RETURN
  1313. > PROCEDURE nest_picture
  1314.   pjg%=XBIOS(4)
  1315.   TEXT 350,103*pjg%,"  --=//\        //|     // ////// ////// //////"
  1316.   TEXT 351,108*pjg%,"    // /\      // |    // //     //       //"
  1317.   TEXT 352,113*pjg%,"   //  \/\    // 9|0  // ////   //////   //"
  1318.   TEXT 353,118*pjg%,"   \\ *  /   //   |  // //         //   //"
  1319.   TEXT 354,123*pjg%,"    \\  / - //    | // //         //   //"
  1320.   TEXT 355,128*pjg%,"     \\/ - //     |// ////// //////   //"
  1321. RETURN
  1322. > PROCEDURE reg_checker
  1323.   IF key_check%=0
  1324.     ALERT 1,"You are using this program| Without a Key| Please Register| See Docs for more info",1,"I Will",a%
  1325.   ENDIF
  1326. RETURN
  1327. PROCEDURE key_confirm
  1328.   OPEN "I",#1,cfg_file$
  1329.   REPEAT
  1330.     LINE INPUT #1,cfg$
  1331.   UNTIL UPPER$(LEFT$(cfg$,5))="SYSOP"
  1332.   CLOSE #1
  1333.   cfg$=TRIM$(MID$(cfg$,6))
  1334.   '  cfg$="ALEXANDER BOCHMANN"
  1335.   '  PRINT "cfg$ ";cfg$
  1336.   lower
  1337.   full_key$=""
  1338.   ' key_check = 1       for good 0 for unreg
  1339.   key_check%=0
  1340.   FOR t%=LEN(key$) TO 1 STEP -1
  1341.     value%=0
  1342.     z$=MID$(key$,t%,1)
  1343.     IF z$="!"
  1344.       z$=" "
  1345.       GOTO skipit
  1346.     ENDIF
  1347.     IF t%/2=INT(t%/2)
  1348.       value%=value%-4
  1349.     ELSE
  1350.       value%=value%+16
  1351.     ENDIF
  1352.     z$=CHR$(ASC(z$)+value%)
  1353.   skipit:
  1354.     full_key$=full_key$+z$
  1355.   NEXT t%
  1356.   IF cfg$=full_key$
  1357.     key_check%=1
  1358.   ENDIF
  1359. RETURN
  1360. > PROCEDURE mes_count
  1361.   show_it
  1362.   pro$="Proc start Mes_count"
  1363.   mesmonth$=store$+"mesmonth.dat"
  1364.   pointer$=store$+"pointer.dat"
  1365.   mes_log$=msglog$
  1366.   '  out_log$="month.log"
  1367.   DIM areas$(200),total%(12,200)
  1368.   FOR t%=1 TO 200
  1369.     areas$(t%)="**"
  1370.   NEXT t%
  1371.   '
  1372.   month$=MID$(DATE$,4,2)
  1373.   month%=VAL(month$)
  1374.   IF EXIST(mesmonth$)
  1375.     open_up
  1376.     IF noway%=99
  1377.       GOTO buggerit
  1378.     ENDIF
  1379.     FOR t%=1 TO 200
  1380.       GET #88,t%
  1381.       total%(1,t%)=jan%
  1382.       total%(2,t%)=feb%
  1383.       total%(3,t%)=mar%
  1384.       total%(4,t%)=apr%
  1385.       total%(5,t%)=may%
  1386.       total%(6,t%)=jun%
  1387.       total%(7,t%)=jul%
  1388.       total%(8,t%)=aug%
  1389.       total%(9,t%)=sep%
  1390.       total%(10,t%)=oct%
  1391.       total%(11,t%)=nov%
  1392.       total%(12,t%)=dec%
  1393.     NEXT t%
  1394.   buggerit:
  1395.   ELSE
  1396.     open_up
  1397.   ENDIF
  1398.   IF EXIST(pointer$)
  1399.     OPEN "R",#89,pointer$,8
  1400.     IF LOF(#89)<>8
  1401.       GOTO blastit
  1402.     ENDIF
  1403.     FIELD #89,4 AT(*timemark%),4 AT(*lastdate%)
  1404.     GET #89,1
  1405.     old_timemark%=timemark%
  1406.     old_date%=lastdate%
  1407.   blastit:
  1408.     timemark%=0
  1409.     lastdate%=0
  1410.   ELSE
  1411.     OPEN "R",#89,pointer$,8
  1412.     FIELD #89,4 AT(*timemark%),4 AT(*lastdate%)
  1413.     old_timemark%=0
  1414.     old_date%=0
  1415.   ENDIF
  1416.   maxy%=200
  1417.   a%=0
  1418.   IF NOT EXIST(areas$)
  1419.     PRINT
  1420.     PRINT "Error......... Areas.BBS file not found, please check all your paths"
  1421.     PRINT
  1422.     CLOSE
  1423.     END
  1424.   ENDIF
  1425.   OPEN "I",#22,areas$
  1426.   show_it
  1427.   LINE INPUT #22,a$
  1428.   DO UNTIL EOF(#22)
  1429.     LINE INPUT #22,a$
  1430.     a$=UPPER$(a$)
  1431.     IF LEFT$(a$,1)<>"-" AND LEFT$(a$,1)<>";"
  1432.       INC a%
  1433.       f%=INSTR(a$," ")
  1434.       a$=TRIM$(MID$(a$,f%))
  1435.       f%=INSTR(a$," ")
  1436.       IF f%<>0
  1437.         a$=TRIM$(LEFT$(a$,f%))
  1438.       ELSE
  1439.         a$=TRIM$(a$)
  1440.       ENDIF
  1441.       areas$(a%)=a$
  1442.     ENDIF
  1443.   LOOP
  1444.   maxmess%=a%
  1445.   CLOSE #22
  1446.   OPEN "I",#11,store$+"msglog.dat"
  1447.   DO UNTIL EOF(#11)
  1448.     LINE INPUT #11,a$
  1449.     timemark$=MID$(a$,10,8)
  1450.     IF INSTR(timemark$,":")=0
  1451.       GOTO notime
  1452.     ENDIF
  1453.     timemark%=VAL(LEFT$(timemark$,2))*3600
  1454.     timemark%=timemark%+(VAL(MID$(timemark$,4,2))*60)
  1455.     timemark%=timemark%+VAL(MID$(timemark$,7,2))
  1456.     lastdate$=MID$(a$,3,2)
  1457.     lastdate%=VAL(lastdate$)
  1458.     IF lastdate%<>old_date%
  1459.       old_date%=lastdate%
  1460.       old_timemark%=0
  1461.     ENDIF
  1462.     '    PRINT timemark;" > ";old_timemark,timemark>old_timemark,lastdate,old_date
  1463.     PAUSE 20
  1464.     IF timemark%>=old_timemark%
  1465.       IF INSTR(a$,"Area")=0 AND INSTR(a$,"------")=0 AND INSTR(a$,"Total")=0
  1466.         a%=INSTR(a$,"|")
  1467.         b%=INSTR(a$,"|",a%+1)
  1468.         c%=INSTR(a$,"COME")+4
  1469.         IF a%>0 AND b%>0
  1470.           amount%=VAL(TRIM$(MID$(a$,a%+1,b%-a%-1)))
  1471.           area$=TRIM$(UPPER$(MID$(a$,c%,a%-c%-1)))
  1472.           '          PRINT amount,area$
  1473.           check_area
  1474.         ENDIF
  1475.       ENDIF
  1476.     ENDIF
  1477.   notime:
  1478.   LOOP
  1479.   CLOSE #11
  1480.   print_screen
  1481. RETURN
  1482. > PROCEDURE check_area
  1483.   FOR t%=1 TO 200
  1484.     IF area$=areas$(t%)
  1485.       '      PRINT "OK, good one..."
  1486.       total%(month%,t%)=total%(month%,t%)+amount%
  1487.       t%=200
  1488.     ENDIF
  1489.   NEXT t%
  1490. RETURN
  1491. > PROCEDURE print_screen
  1492.   show_it
  1493.   PRINT "Writing Monthly Message log."
  1494.   timemark%=timemark%+1
  1495.   liner$=""
  1496.   t%=0
  1497.   OPEN "O",#45,out_log$
  1498.   PRINT #45,"        FidoMail Monthly Message Activity Log (c) 1992 P.Gadsby "
  1499.   PRINT #45,"         Part of FSCAN (c) D.M.Brewood & P.Gadsby 1991/1992"
  1500.   PRINT #45
  1501.   PRINT #45,"Area                Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec"
  1502.   PRINT #45,"------------------------------------------------------------------------------"
  1503.   PRINT #45
  1504.   DO UNTIL t%=201
  1505.     liner$=STRING$(78,32)
  1506.     INC t%
  1507.     IF areas$(t%)="**"
  1508.       t%=201
  1509.       GOTO whoop
  1510.     ELSE
  1511.       MID$(liner$,1,18)=areas$(t%)
  1512.     ENDIF
  1513.     FOR m%=1 TO 12
  1514.       off%=m%*5
  1515.       pjg$=STR$(total%(m%,t%))
  1516.       MID$(liner$,19+off%-LEN(pjg$))=pjg$
  1517.     NEXT m%
  1518.     PRINT #45,liner$
  1519.   LOOP
  1520.   CLOSE #45
  1521. whoop:
  1522.   write_new_file
  1523. RETURN
  1524. > PROCEDURE write_new_file
  1525.   show_it
  1526.   '  PRINT lastdate,timemark
  1527.   PUT #89,1
  1528.   PRINT "Writing Data Files....."
  1529.   FOR z%=1 TO 200
  1530.     jan%=total%(1,z%)
  1531.     feb%=total%(2,z%)
  1532.     mar%=total%(3,z%)
  1533.     apr%=total%(4,z%)
  1534.     may%=total%(5,z%)
  1535.     jun%=total%(6,z%)
  1536.     jul%=total%(7,z%)
  1537.     aug%=total%(8,z%)
  1538.     sep%=total%(9,z%)
  1539.     oct%=total%(10,z%)
  1540.     nov%=total%(11,z%)
  1541.     dec%=total%(12,z%)
  1542.     PUT #88,z%
  1543.   NEXT z%
  1544. RETURN
  1545. > PROCEDURE open_up
  1546.   OPEN "r",#88,mesmonth$,48
  1547.   FIELD #88,4 AT(*jan%),4 AT(*feb%),4 AT(*mar%),4 AT(*apr%),4 AT(*may%),4 AT(*jun%)
  1548.   FIELD #88,4 AT(*jul%),4 AT(*aug%),4 AT(*sep%),4 AT(*oct%),4 AT(*nov%),4 AT(*dec%)
  1549.   IF LOF(#88)<>9600
  1550.     noway%=99
  1551.   ENDIF
  1552. RETURN
  1553. PROCEDURE lower
  1554.   cfg$=UPPER$(cfg$)
  1555.   FOR x%=1 TO LEN(cfg$)
  1556.     b$=MID$(cfg$,x%,1)
  1557.     fred%=ASC(b$)
  1558.     IF fred%>=65 AND fred%<=90
  1559.       fred%=fred%+32
  1560.       te$=te$+CHR$(fred%)
  1561.     ELSE
  1562.       te$=te$+" "
  1563.     ENDIF
  1564.   NEXT x%
  1565.   lowname$=te$
  1566.   lowname$=TRIM$(lowname$)
  1567.   cfg$=lowname$
  1568.   convert_to_upper
  1569.   te$=""
  1570. RETURN
  1571. PROCEDURE convert_to_upper
  1572.   cfg$=UPPER$(LEFT$(cfg$,1))+MID$(cfg$,2)
  1573. fuckit:
  1574.   spa%=INSTR(cfg$," ",flag%)
  1575.   '  PRINT spa
  1576.   IF spa%>1
  1577.     cfg$=LEFT$(cfg$,spa%)+UPPER$(MID$(cfg$,spa%+1,1))+MID$(cfg$,spa%+1+1)
  1578.     flag%=spa%+1
  1579.   ENDIF
  1580.   IF spa%<>0
  1581.     GOTO fuckit
  1582.   ENDIF
  1583.   '  PRINT "cfg$ ";cfg$
  1584.   ' ~INP(2)
  1585.   ' STOP
  1586. RETURN
  1587. mask:
  1588. DATA 29
  1589. DATA "@FIDONET.ORG"," @ FIDONET.ORG"
  1590. DATA "@Fidonet.org"," @ Fidonet.Org"
  1591. DATA " FIDONET "
  1592. DATA "@CHRISTNET.FTN"," @ CHRISTNET.FTN"
  1593. DATA "@Christnet.Ftn"," @ Christnet.Ftn"
  1594. DATA " CHRISTNET "
  1595. DATA "@NEST.FTN"," @ NEST.FTN"
  1596. DATA "@Nest.Ftn"," @ Nest.Ftn"
  1597. DATA " NEST "
  1598. DATA "@MYSTIC.FTN"," @ MYSTIC.FTN"
  1599. DATA "@Mystic.Ftn"," @ Mystic.Ftn"
  1600. DATA " MYSTIC "
  1601. DATA "@FNET.FTN"," @ FNET.FTN"
  1602. DATA "@Fnet.Ftn"," @ Fnet.Ftn"
  1603. DATA " FNET "
  1604. DATA ".FTN",".ORG"
  1605. DATA "@"," @ "
  1606. meek:
  1607. DATA 3,12,24,96
  1608. bad:
  1609. DATA 3
  1610. DATA "BEN VAN BOKKEM"
  1611. DATA "BOKKEM"
  1612. DATA "FLORENTINE"
  1613. good:
  1614. DATA 5
  1615. DATA "PHIL GADSBY"
  1616. DATA "JAMES PARTNER"
  1617. DATA "DARON BREWOOD"
  1618. DATA "MICK COLEMAN"
  1619. DATA "STEVE CAPLE"
  1620.