home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / FDLA101E.ZIP / FDLA101E.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-06-04  |  82.8 KB  |  2,319 lines
  1.     DEFINT A-Z
  2.     DECLARE FUNCTION BackInstr% (Start%, searchString$, subString$)
  3.     DECLARE SUB Copyright ()
  4.     DECLARE SUB DisplayReport ()
  5.     DECLARE SUB Editor (Ed$, ActiveLenght%, ScanCode%, NumOnly%, CapsOn%, NormalColor%, EditColor%, Row%, Column%)
  6.     DECLARE FUNCTION ErrorCode$ (Code%)
  7.     DECLARE FUNCTION Exist% (filename$)
  8.     DECLARE SUB ErrorMessage (message$)
  9.     DECLARE FUNCTION ExeName$
  10.     DECLARE FUNCTION FindLast% (BYVAL Address, Size)
  11.     DECLARE SUB Help ()
  12.     DECLARE SUB InputLine (IOCHAN%, BUFSIZE%, STATUS%, TEXT$)
  13.     DECLARE FUNCTION ItsMail% (Work$)
  14.     DECLARE SUB LocRowCol (X%, Y%)
  15.     DECLARE FUNCTION LineCount% (filename$, BUFFER$)
  16.     DECLARE SUB ParseLine (X$, sep$, a$())
  17.     DECLARE SUB ParseWord (a$, sep$, word$)
  18.     DECLARE FUNCTION ParseString$ (CurPos%, Work$, Delimit$)
  19.     DECLARE SUB PrtCtrDisp (PrtRec%)
  20.     DECLARE FUNCTION QInstrB (Start%, Source$, Search$)
  21.     DECLARE SUB ReportTPLs (TPL%, Fhandle%)
  22.     DECLARE SUB ScrnRest (ULRow%, ULCol%, LRRow%, LRCol%, SEG Element%, Page%)
  23.     DECLARE SUB ScrnSave (ULRow%, ULCol%, LRRow%, LRCol%, SEG Element%, Page%)
  24.     DECLARE SUB SetLevel (ErrVal%)
  25.     DECLARE SUB YesNo (YN$, Prompt$, ScanCode, NormalColr, EditColr, Row, Column)
  26.   
  27.   'Front Door 2.01 Log Analyzer program FDLA
  28.   'Copyright by RJ Ross 1991
  29.   'Requires Quick Pack Pro Library
  30.   'Program Started September 8th, 1991
  31.   'Beta Ver .001 released 21 Oct 91
  32.   'Version 1.00 released 11 Dec 91
  33.   'Version 1.01b beta 29 Nov 92 - increased print positions in CallsOut column Pt 1
  34.   '                             - modified parsing to Calling record to parse forward
  35.   'Version 1.01c beta    Jul 93 - added 16,800 & 14,400 BBS caller stats
  36.   'Version 1.01d beta           - changed BBS caller stats var from integer to
  37.   '                             - long to prevent lockup.
  38.   '                             - corrected BBS caller totals to include BBS14 and
  39.   '                             - BBS16 connects.
  40.  
  41.   '******************
  42.   'Some declarations
  43.   '******************
  44.   
  45.     COMMON SHARED CR$, LF$, CRLF$
  46.     CONST FDLAVersion$ = "1.01e" 'current version number
  47.     CONST Copyright1$ = "Front Door Log Analyzer - FDLA Version "
  48.     CONST Copyright2$ = "Copyright 1991 by RJ (Bob) Ross - ALL RIGHTS RESERVED"
  49.     CONST Copyright3$ = "SysOp - RJ's Byteline BBS - FidoNet 1:134/75"
  50.   
  51.     CONST False = 0
  52.     CONST True = NOT False
  53.     CONST Comma = ","
  54.   
  55.     SysName$ = "P^Not Defined@^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&"
  56.   
  57.   'For debugging
  58.   ' SysName$ = "P^RJ's Byteline BBS@^&^&^&^&^&^&^&^&^&^&^&^&"
  59.  
  60.     CR$ = CHR$(13)
  61.     LF$ = CHR$(10)
  62.     CRLF$ = CR$ + LF$
  63.   
  64.     REDIM SHARED Scrn%(2000)
  65.     CALL ScrnSave(1, 1, 25, 80, SEG Scrn%(1), -1)
  66.   
  67.     LogFile$ = "FD.LOG"
  68.     Ctr% = 0
  69.   
  70.     DIM SHARED HighAscii%
  71.     DIM ExcludNet$(11)
  72.     DIM ExcludFiles$(11)
  73.     HighAscii% = True
  74.     DispRpt% = False
  75.   
  76.     RptPtI% = False
  77.     RptPtII% = False
  78.     RptPtIII% = False
  79.     RptPtIV% = False
  80.     RptPtV% = False
  81.     SortFlag% = False
  82.     DelTempFiles% = True
  83.     ExFil% = False
  84.     ExNet% = False
  85.     ChopFile% = False
  86.     ChopNet% = False
  87.     NoResponse% = False
  88.     MkDataFile% = False
  89.     SysName% = False
  90.   
  91.     DIM ParsWrd$(1 TO 10)
  92.     DIM CallingNode$(1 TO 2)     'to parse calling node number  1.01b
  93.   
  94.     IF HighAscii% THEN
  95.         Bar$ = "│"
  96.     ELSE
  97.         Bar$ = "|"
  98.     END IF
  99.   
  100.   '********************
  101.   ' Global error trap
  102.   '********************
  103.   
  104.    ON ERROR GOTO ErrHandler
  105.   
  106.   '**********************
  107.   'Command line switches
  108.   '**********************
  109.   
  110.   'Add System Name to the Exe file
  111.     IF INSTR(COMMAND$, "-SN") THEN
  112.         CALL Copyright
  113.         PRINT STRING$(80, "─")
  114.         EditColor% = 112
  115.         NormColor% = 112
  116.         CALL LocRowCol(6, 1)
  117.         Temp1$ = SPACE$(40)
  118.         PRINT "This option will allow you to configure FDLA.EXE to automatically place"
  119.         PRINT "the name of your BBS system at the top of FDLA output report."
  120.         PRINT
  121.         PRINT "You may press Esc to abort this function, if desired, and return to DOS."
  122.         DO
  123.             CALL LocRowCol(11, 1)
  124.             PRINT "Your System Name: ";
  125.             Editor Temp1$, Length%, ScanCode%, 0, 0, NormColor%, EditColor%, 11, 18
  126.             IF ScanCode% = 27 THEN
  127.                 CALL LocRowCol(14, 1)
  128.                 PRINT "Aborted - System Name not changed."
  129.                 END
  130.             END IF
  131.             Msg$ = "OK?  "
  132.             YN$ = "N"
  133.             YesNo YN$, Msg$, ScanCode%, 7, EditColor%, 12, 1
  134.             IF ScanCode% = 27 THEN
  135.                 CALL LocRowCol(14, 1)
  136.                 PRINT "Aborted - System Name not changed."
  137.                 END
  138.             END IF
  139.         LOOP UNTIL UCASE$(YN$) = "Y"
  140.       
  141.         IF UCASE$(YN$) = "Y" THEN
  142.             Temp1$ = LTRIM$(RTRIM$(Temp1$))
  143.             Temp1$ = Temp1$ + "@"
  144.             LookingFor$ = "P^"
  145.             filename$ = ExeName$
  146.           ' filename$ = "FDLA.EXE"    'to run in the QB Environment
  147.             FilePointer& = 1
  148.             OurHandle% = FREEFILE
  149.             OPEN filename$ FOR BINARY AS #OurHandle%
  150.             DO WHILE NOT EOF(OurHandle%)
  151.                 SEEK OurHandle%, FilePointer&
  152.                 a$ = INPUT$(4096, OurHandle%)
  153.                 Result% = INSTR(a$, LookingFor$)
  154.                 IF Result% THEN
  155.                     FilePos& = (SEEK(OurHandle%)) - ((LEN(a$) - Result% + 1))
  156.                     EXIT DO
  157.                 END IF
  158.                 FilePointer& = SEEK(OurHandle%) - LEN(LookingFor$)
  159.             LOOP
  160.             IF Result% THEN
  161.                 FilePos& = (SEEK(OurHandle%)) - ((LEN(a$) - Result% + 1))
  162.                 PUT OurHandle%, FilePos& + 2, Temp1$
  163.                 CALL LocRowCol(14, 1)
  164.                 PRINT "Update completed "; filename$; " modified."
  165.                 END
  166.             ELSE
  167.                 CALL LocRowCol(14, 1)
  168.                 PRINT "Failed to update "; filename$
  169.                 END
  170.             END IF
  171.         END IF
  172.     END IF
  173.   'Help Screen
  174.     IF INSTR(COMMAND$, "-H") THEN
  175.         CALL Copyright
  176.         CALL Help
  177.         END
  178.     END IF
  179.   
  180.   'List the last created report FDLARpt.txt file
  181.     IF INSTR(COMMAND$, "-LL") THEN
  182.       'IF FnFileExist%("FDLARpt.Txt") THEN
  183.         IF Exist%("FDLARpt.Txt") THEN
  184.             CALL DisplayReport
  185.             CALL ScrnRest(1, 1, 25, 80, SEG Scrn%(1), -1)
  186.             END
  187.         ELSE
  188.             BEEP
  189.             DOSError$ = ErrorCode$(53)
  190.             CALL ErrorMessage(DOSError$)
  191.             CALL LocRowCol(15, 24)
  192.             PRINT "Unable to locate file FDLARPT.TXT"
  193.             CALL SetLevel(1)
  194.             END
  195.         END IF
  196.     END IF
  197.   
  198.   'Make FDLARpt.Dat (Data file of Part I)
  199.     IF INSTR(COMMAND$, "-D") THEN
  200.         MkDataFile% = True
  201.     END IF
  202.   
  203.   'List FDLARpt.txt after created
  204.     IF INSTR(COMMAND$, "-L") THEN DispRpt% = True
  205.   
  206.   'Use a different Log file (default FD.Log in current dir)
  207.     P% = INSTR(COMMAND$, "LOG=")
  208.     IF P% THEN
  209.         Temp$ = MID$(COMMAND$, P% + 4)
  210.         P% = INSTR(Temp$, " ")
  211.         IF P% THEN Temp$ = LEFT$(Temp$, P% - 1)
  212.         LogFile$ = Temp$
  213.     END IF
  214.  
  215.   'Exclude a net/nets, etc from FDLARpt.txt       -  -EXN
  216.   '------------------------------------------------------
  217.     P% = INSTR(COMMAND$, "-EXN")
  218.     IF P% THEN
  219.         AXNets$ = MID$(COMMAND$, P%)
  220.         P% = INSTR(AXNets$, " ")
  221.         Posn% = 5
  222.         IF P% THEN AXNets$ = LEFT$(AXNets$, P% - 1)
  223.         DO
  224.             ExcludNet$(Ex%) = ParseString$(Posn%, AXNets$, ",")
  225.             Ex% = Ex% + 1
  226.         LOOP UNTIL Posn% = LEN(AXNets$) OR Ex% = 11
  227.         Last% = FindLast%(BYVAL VARPTR(ExcludNet$(11)), 11)
  228.         IF Last% THEN
  229.             ExNet% = True
  230.         END IF
  231.     END IF
  232.  
  233.   'Suppress files in Part II          -SUP
  234.   '----------------------------------------
  235.     P% = INSTR(COMMAND$, "-SUP")
  236.     IF P% THEN
  237.         AXFiles$ = MID$(COMMAND$, P%)
  238.         P% = INSTR(AXFiles$, " ")
  239.         Posn% = 5
  240.         IF P% THEN AXFiles$ = LEFT$(AXFiles$, P% - 1)
  241.         DO
  242.             ExcludFiles$(ExF%) = ParseString$(Posn%, AXFiles$, ",")
  243.             ExF% = ExF% + 1
  244.         LOOP UNTIL Posn% = LEN(AXFiles$) OR ExF% = 11
  245.         LastF% = FindLast%(BYVAL VARPTR(ExcludFiles$(11)), 11)
  246.         IF LastF% THEN
  247.             ExFil% = True
  248.         END IF
  249.     END IF
  250.  
  251.   'Don't use High Ascii characters in FDLARpt.Txt
  252.     IF INSTR(COMMAND$, "-NHA") THEN
  253.         HighAscii% = False
  254.     END IF
  255.   
  256.   'Don't erase the Temp work files (.$$$, .$$S)
  257.     IF INSTR(COMMAND$, "-KTF") THEN
  258.         DelTempFiles% = False
  259.     END IF
  260.   
  261.   
  262.     IF HighAscii% THEN
  263.         Bar$ = "│"
  264.     ELSE
  265.         Bar$ = "|"
  266.     END IF
  267.   
  268.   'Record definition for the Work Files
  269.   
  270.     DIM MNode1 AS STRING * 15
  271.     DIM MCallsOut1 AS INTEGER
  272.     DIM MConnect1 AS INTEGER
  273.     DIM MCallsIn1 AS INTEGER
  274.     DIM MByteOut1 AS LONG
  275.     DIM MByteIn1 AS LONG
  276.     DIM MTimeOut1 AS INTEGER
  277.     DIM MTimeIn1 AS INTEGER
  278.   
  279.     DIM MNode2 AS STRING * 15
  280.     DIM MCallsOut2 AS INTEGER
  281.     DIM MConnect2 AS INTEGER
  282.     DIM MCallsIn2 AS INTEGER
  283.     DIM MByteout2 AS LONG
  284.     DIM MByteIn2 AS LONG
  285.     DIM MTimeOut2 AS INTEGER
  286.     DIM MTimeIn2 AS INTEGER
  287.   
  288.     TYPE FileRec
  289.         FileNm AS STRING * 12
  290.         FileByteOut AS LONG
  291.         FileByteIn AS LONG
  292.         FileCPS AS INTEGER
  293.     END TYPE
  294.     DIM FileRecE AS FileRec
  295.   
  296.     GOSUB InitMRecE
  297.     GOSUB InitFileRecE
  298.     CALL Copyright
  299.   
  300.   'Open the FD.LOG for read access
  301.   
  302.     IF NOT Exist%(LogFile$) THEN
  303.         BEEP
  304.         DOSError$ = ErrorCode$(53)
  305.         CALL ErrorMessage(DOSError$)
  306.         CALL LocRowCol(15, 24)
  307.         PRINT "Unable to locate file "; LogFile$
  308.         CALL SetLevel(1)
  309.         END
  310.     END IF
  311.   
  312.     FDLF% = FREEFILE
  313.     OPEN LogFile$ FOR INPUT AS FDLF%
  314.   
  315.   'Get the start time and date from the logfile
  316.   
  317.     DO UNTIL EOF(FDLF%)
  318.         LINE INPUT #FDLF%, Record$
  319.         IF INSTR(1, Record$, "---") THEN
  320.             IF INSTR(28, Record$, "FD") THEN
  321.               'Start Day & Date
  322.                 BeginFd$ = MID$(Record$, 13, 13)
  323.                 LINE INPUT #FDLF%, Record$
  324.               'Start Time
  325.                 Temp$ = MID$(Record$, 3, 8)
  326.                 BeginFd$ = BeginFd$ + " " + Temp$
  327.                 EXIT DO
  328.             END IF
  329.           ' IF INSTR(13, Record$, ",") THEN
  330.             IF MID$(Record$, 13, 1) = "," THEN
  331.                 P% = INSTR(13, RRECORD$, ",")
  332.                 BeginFd$ = MID$(Record$, 13, P% - 1)
  333.                 LINE INPUT #FDLF%, Record$
  334.               'Start Time
  335.                 Temp$ = MID$(Record$, 3, 8)
  336.                 BeginFd$ = BeginFd$ + " " + Temp$
  337.                 EXIT DO
  338.             END IF
  339.                 BeginFd$ = MID$(Record$, 13)
  340.                 LINE INPUT #FDLF%, Record$
  341.               'Start Time
  342.                 Temp$ = MID$(Record$, 3, 8)
  343.                 BeginFd$ = BeginFd$ + " " + Temp$
  344.                 EXIT DO
  345.         END IF
  346.     LOOP
  347.     IF EOF(FDLF%) THEN BeginFd$ = "NO START TIME"
  348.     CLOSE FDLF%
  349.  
  350.   'Open LogFile$ to read in Binary mode
  351.  
  352.     CHAN = FREEFILE
  353.     OPEN LogFile$ FOR BINARY AS #CHAN
  354.     MAXSIZE = 4 * 1024
  355.     FILESTAT = 1
  356.   
  357.   '***********************************************
  358.   'Make the Mail temp files ready to receive data
  359.   '***********************************************
  360.   
  361.     MTmp% = FREEFILE
  362.     OPEN "FDLATmp.$$$" FOR OUTPUT AS MTmp%      'Message Transfers & Calls
  363.     FTmp% = FREEFILE
  364.     OPEN "FDLATmpF.$$$" FOR OUTPUT AS FTmp%     'File Transfers & Calls
  365.     UTmp% = FREEFILE
  366.     OPEN "FDLATmpU.$$$" FOR OUTPUT AS UTmp%     'Undialable Nodes
  367.     CTmp% = FREEFILE
  368.     OPEN "FDLATmpC.$$$" FOR OUTPUT AS CTmp%     'Session cost
  369.   
  370.   'Write heading for the Session cost temp file
  371.   
  372.     CALL ReportTPLs(5, CTmp%)
  373.   
  374.   '*************************************
  375.   '  Mail Loop to Create the data files
  376.   '*************************************
  377.   
  378.     WHILE NOT FILESTAT = -1
  379.        DO UNTIL FILESTAT = -1
  380.           'End of LogFile
  381.             PrevRecord$ = Record$
  382.             IF FILESTAT = -1 THEN
  383.                CLOSE #CHAN
  384.                EXIT DO
  385.                ELSE
  386.                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  387.             END IF
  388.             IF INSTR(1, Record$, "+") THEN
  389.                 HoldRecord$ = Record$
  390.                 EndTime$ = MID$(Record$, 3, 8)
  391.             END IF
  392.  
  393.             Ctr% = Ctr% + 1
  394.             CALL LocRowCol(12, 15)
  395.             PRINT "Scanning "; LogFile$; " :"; Ctr%
  396.             IF INSTR(1, Record$, "---") THEN
  397.                IF INSTR(28, Record$, "FD") THEN
  398.                   'End Day & Date
  399.                     EndFd$ = MID$(Record$, 13, 13)
  400.                ELSE
  401.                     EndFd$ = MID$(Record$, 13, 13)
  402.                     IF RIGHT$(EndFd$, 1) = "," THEN
  403.                         EndFd$ = LEFT$(EndFd$, 12)
  404.                     END IF
  405.                END IF
  406.             IF FILESTAT = -1 THEN
  407.                CLOSE #CHAN
  408.                EXIT DO
  409.                ELSE
  410.                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  411.             END IF
  412.                     Ctr% = Ctr% + 1
  413.                     CALL LocRowCol(12, 15)
  414.                     PRINT "Scanning "; LogFile$; " :"; Ctr%
  415.                 END IF
  416.  
  417.           'Insufficient disk space
  418.           '-----------------------
  419.             IF INSTR(13, Record$, "Insufficient disk space for") THEN
  420.                 EXIT DO
  421.             END IF
  422.  
  423.           'Undialable node
  424.           '---------------
  425.             IF INSTR(13, Record$, "Undialable node") THEN
  426.                 subString$ = " "
  427.                 P% = BackInstr%(0, Record$, subString$)
  428.                 IF P% THEN
  429.                     MNode1 = LTRIM$(MID$(Record$, P% + 1))
  430.                     GOSUB WriteUTmpRec
  431.                     GOSUB InitMRecE
  432.                     EXIT DO
  433.                 END IF
  434.             END IF
  435.           
  436.           'Session Cost calls
  437.           '------------------
  438.             IF INSTR(1, Record$, "$") THEN
  439.                 IF INSTR(13, Record$, "To") THEN
  440.                     subString$ = " "
  441.                     P% = BackInstr%(0, Record$, subString$)
  442.                     IF P% THEN
  443.                         Cost& = VAL(MID$(Record$, P%))
  444.                         IF Cost& THEN
  445.                            'to fix a bug in FD.log where cost is entered
  446.                            'as 32768.
  447.                             IF Cost& > 30000 THEN EXIT DO
  448.                             AtTime$ = RTRIM$(MID$(Record$, 3, 10))
  449.                             Temp$ = MID$(Record$, 15)
  450.                             P% = INSTR(Temp$, ",")
  451.                             IF P% THEN
  452.                                 MNode1 = LTRIM$(LEFT$(Temp$, P% - 1))
  453.                                 IF ExNet% THEN
  454.                                    FOR X% = 1 TO Last%
  455.                                        IF INSTR(MNode1, ExcludNet$(X%)) THEN
  456.                                            ChopNet% = True
  457.                                            EXIT FOR
  458.                                        END IF
  459.                                    NEXT
  460.                                  END IF
  461.                                  IF ChopNet% THEN
  462.                                     ChopNet% = False
  463.                                     EXIT DO
  464.                                  END IF
  465.                                 RptPtIII% = True
  466.                                 P% = INSTR(Temp$, ",")
  467.                                 IF P% THEN SessTime$ = MID$(Temp$, P% + 1)
  468.                                 P% = INSTR(SessTime$, ",")
  469.                                 IF P% THEN SessTime$ = LTRIM$(MID$(SessTime$, 1, P% - 1))
  470.                               'so now we have: MNode1     (Node number)
  471.                               '              : EndFD$            (date)
  472.                               '              : AtTime$           (Logged at - time)
  473.                               '              : SessTime$         (Session time)
  474.                               '              : Cost%             (Session cost)
  475.                                 RptPtIII% = True
  476.                                 sep$ = " "
  477.                                 ParseLine EndFd$, sep$, ParsWrd$()
  478.                                 LoggedDate$ = ParsWrd$(2) + " " + ParsWrd$(3) + " " + ParsWrd$(4)
  479.                                 sep$ = ":"
  480.                                 ParseLine SessTime$, sep$, ParsWrd$()
  481.                                 SessMin% = VAL(ParsWrd$(1))
  482.                                 SessSec% = VAL(ParsWrd$(2))
  483.                                 Cost! = Cost& / 100
  484.                                 PRINT #CTmp%, Bar$; MNode1; TAB(17); LoggedDate$;
  485.                                 PRINT #CTmp%, TAB(28); AtTime$; '
  486.                                 PRINT #CTmp%, TAB(43);
  487.                                 PRINT #CTmp%, USING "##"; SessHrs%;
  488.                                 PRINT #CTmp%, TAB(49);
  489.                                 PRINT #CTmp%, USING "####"; SessMin%;
  490.                                 PRINT #CTmp%, TAB(57);
  491.                                 PRINT #CTmp%, USING "##"; SessSec%;
  492.                                 PRINT #CTmp%, TAB(66);
  493.                                 PRINT #CTmp%, USING "$####.##"; Cost!;
  494.                                 PRINT #CTmp%, TAB(76); Bar$
  495.                                 TotSessCost! = TotSessCost! + Cost!
  496.                                 GOSUB InitMRecE
  497.                                 EXIT DO
  498.                             END IF
  499.                         END IF
  500.                     END IF
  501.                 END IF
  502.             END IF
  503.           
  504.           'RING
  505.           '****
  506.             IF INSTR(13, Record$, "RING") THEN
  507.                 IF NoResponse% THEN
  508.                     WroteMRec% = True
  509.                     GOSUB WriteMTmpRec
  510.                     GOSUB InitMRecE
  511.                     NoResponse% = False
  512.                     EXIT DO
  513.                 END IF
  514.                 IF INSTR(13, PrevRecord$, "Calling") THEN
  515.                   'There must have been a call collision
  516.                     WroteMRec% = True
  517.                     GOSUB WriteMTmpRec
  518.                     GOSUB InitMRecE
  519.                     EXIT DO
  520.                 END IF
  521.             END IF
  522.           
  523.           'BUSY
  524.           '****
  525.             IF INSTR(13, Record$, "BUSY") THEN
  526.                 MConnect1 = 0
  527.                 WroteMRec% = True
  528.                 GOSUB WriteMTmpRec
  529.                 GOSUB InitMRecE
  530.                 EXIT DO
  531.             END IF
  532.           
  533.           'NO DIAL
  534.           '*******
  535.             IF INSTR(13, Record$, "NO DIAL") THEN
  536.                 IF OutgoingCall% THEN
  537.                     MConnect1 = 0
  538.                     WroteMRec% = True
  539.                     GOSUB WriteMTmpRec
  540.                     GOSUB InitMRecE
  541.                     EXIT DO
  542.                 END IF
  543.             END IF
  544.           
  545.          'NO CARRIER
  546.           '**********
  547.             IF INSTR(13, Record$, "NO CARRIER") THEN
  548.                 IF OutgoingCall% THEN
  549.                     MConnect1 = 0
  550.                     WroteMRec% = True
  551.                     GOSUB WriteMTmpRec
  552.                     GOSUB InitMRecE
  553.                     EXIT DO
  554.                 END IF
  555.             END IF
  556.           
  557.           'Using: Fido
  558.           '-----------
  559.             IF INSTR(13, Record$, "Using: Fido") AND NOT OutgoingCall% THEN
  560.                 subString$ = ","
  561.                 P% = BackInstr%(0, HoldRecord$, subString$)
  562.                 IF P% THEN
  563.                     MNode1 = LTRIM$(MID$(HoldRecord$, P% + 1))
  564.                     MConnect1 = 1
  565.                     MCallsIn1 = 1
  566.                 END IF
  567.             END IF
  568.           
  569.           'Outgoing Mail
  570.           '-------------
  571.             IF INSTR(13, Record$, "Sent") THEN
  572.                 IF ItsMail%(Record$) THEN
  573.                     subString$ = ";"
  574.                     P% = BackInstr%(0, Record$, subString$)
  575.                     IF P% THEN
  576.                         ByteOut& = VAL(MID$(Record$, P% + 1))
  577.                         MByteOut1 = MByteOut1 + ByteOut&
  578.                         subString$ = Comma
  579.                         P% = BackInstr%(0, Record$, subString$)
  580.                         OutCPS% = VAL(MID$(Record$, P% + 1))
  581.                         IF OutCPS% THEN
  582.                             TimeOut& = ByteOut& / OutCPS%
  583.                             MTimeOut1 = MTimeOut1 + TimeOut&
  584.                         ELSE
  585.                             MTimeOut1 = 0
  586.                         END IF
  587.                     END IF
  588.                 ELSE
  589.                     subString$ = "\"
  590.                     P% = BackInstr%(0, Record$, subString$)
  591.                     IF P% THEN
  592.                         Temp$ = MID$(Record$, P% + 1)
  593.                         IF RIGHT$(Temp$, 4) = ".REQ" THEN
  594.                            FileRecE.FileNm = Temp$
  595.                         END IF
  596.                         subString$ = ","
  597.                         P% = BackInstr%(0, Temp$, subString$)
  598.                         IF P% THEN
  599.                             FileRecE.FileCPS = VAL(MID$(Temp$, P% + 1))
  600.                         ELSE
  601.                             FileRecE.FileCPS = 0
  602.                         END IF
  603.                         subString$ = ";"
  604.                         P% = BackInstr%(0, Temp$, subString$)
  605.                         IF P% THEN
  606.                             FileRecE.FileByteOut = VAL(MID$(Temp$, P% + 1))
  607.                             FileRecE.FileNm = LEFT$(Temp$, P% - 1)
  608.                         ELSE
  609.                             FileRecE.FileByteOut = 0
  610.                         END IF
  611.                         GOSUB WriteFTmpRec
  612.                         GOSUB InitFileRecE
  613.                         EXIT DO
  614.                     END IF
  615.                 END IF
  616.             END IF
  617.           
  618.           ' Calling(outgoing call)
  619.           '-----------------------
  620.             IF INSTR(13, Record$, "Calling") THEN
  621.                 IF NoResponse% = True THEN
  622.                     WroteMRec% = True
  623.                     GOSUB WriteMTmpRec
  624.                     GOSUB InitMRecE
  625.                     NoResponse% = False
  626.                 END IF
  627.                 OutgoingCall% = True
  628.                 MCallsOut1 = 1
  629.               ' subString$ = Comma
  630.                 CallingNode$(2) = ""                         '1.01b
  631.                 sep$ = ","                                   '1.01b
  632.                 ParseLine Record$, sep$, CallingNode$()      '1.01b
  633.                 MNode1 = LTRIM$(CallingNode$(2))             '1.01b
  634.               ' P% = BackInstr%(0, Record$, subString$)
  635.               ' IF P% THEN
  636.               '     Temp$ = LEFT$(Record$, P% - 1)
  637.               '     P% = BackInstr%(0, Temp$, subString$)
  638.               '     MNode1 = LTRIM$(MID$(Temp$, P% + 1))
  639.               ' END IF
  640.             END IF
  641.           
  642.           'Incoming mail
  643.           '-------------
  644.             IF INSTR(13, Record$, "Rcvd") THEN
  645.                 IF ItsMail%(Record$) THEN
  646.                     subString$ = ";"
  647.                     P% = BackInstr%(0, Record$, subString$)
  648.                     IF P% THEN
  649.                         ByteIn& = VAL(MID$(Record$, P% + 1))
  650.                         MByteIn1 = MByteIn1 + ByteIn&
  651.                         subString$ = Comma
  652.                         P% = BackInstr%(0, Record$, subString$)
  653.                         InCPS% = VAL(MID$(Record$, P% + 1))
  654.                         IF InCPS% THEN
  655.                             TimeIn& = ByteIn& / InCPS%
  656.                             MTimeIn1 = MTimeIn1 + TimeIn&
  657.                         ELSE
  658.                             MTimeIn1 = 0
  659.                         END IF
  660.                     END IF
  661.                 'incomplete
  662.                 '----------
  663.                 ELSEIF INSTR(Record$, "(incomplete)") THEN
  664.                    FileRecE.FileCPS = 0
  665.                    FileRecE.FileByteIn = 0
  666.                    subString$ = "\"
  667.                    P% = BackInstr%(0, Record$, subString$)
  668.                    Temp$ = MID$(Record$, P% + 1)
  669.                    P% = INSTR(Temp$, ",")
  670.                    IF P% THEN
  671.                        FileRecE.FileNm = LEFT$(Temp$, P% - 1)
  672.                         GOSUB WriteFTmpRec
  673.                         GOSUB InitFileRecE
  674.                    END IF
  675.                 ELSE
  676.                     subString$ = "\"
  677.                     P% = BackInstr%(0, Record$, subString$)
  678.                     IF P% THEN
  679.                         Temp$ = MID$(Record$, P% + 1)
  680.                         subString$ = ","
  681.                         P% = BackInstr%(0, Temp$, subString$)
  682.                         FileRecE.FileCPS = VAL(MID$(Temp$, P% + 1))
  683.                         subString$ = ";"
  684.                         P% = BackInstr%(0, Temp$, subString$)
  685.                         FileRecE.FileByteIn = VAL(MID$(Temp$, P% + 1))
  686.                         FileRecE.FileNm = LEFT$(Temp$, P% - 1)
  687.                         GOSUB WriteFTmpRec
  688.                         GOSUB InitFileRecE
  689.                     END IF
  690.                 END IF
  691.             END IF
  692.           
  693.           'Mail transfer completed
  694.           '-----------------------
  695.             IF INSTR(13, Record$, "Mail transfer completed") THEN
  696.                 IF INSTR(MNode1, "Unknown") THEN
  697.             IF FILESTAT = -1 THEN
  698.                CLOSE #CHAN
  699.                EXIT DO
  700.                ELSE
  701.                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  702.             END IF
  703.                     IF INSTR(13, Record$, "To") OR INSTR(13, Record$, "From") THEN
  704.                         Temp$ = MID$(Record$, 13)
  705.                         P% = INSTR(Temp$, ",")
  706.                         IF P% THEN
  707.                             Temp$ = LEFT$(Temp$, P% - 1)
  708.                             P% = INSTR(Temp$, " ")
  709.                             MNode1 = MID$(Temp$, P% + 1)
  710.                         END IF
  711.                     END IF
  712.                 END IF
  713.                 WroteMRec% = True
  714.                 GOSUB WriteMTmpRec
  715.                 GOSUB InitMRecE
  716.             END IF
  717.           
  718.           'Unable to complete mail transfer
  719.           '--------------------------------
  720.             IF INSTR(13, Record$, "Unable to complete mail transfer") THEN
  721.                 WroteMRec% = True
  722.                 GOSUB WriteMTmpRec
  723.                 GOSUB InitMRecE
  724.             END IF
  725.  
  726.           'Mail received (An exception if "Mail transfer completed" not in log)
  727.           '--------------------------------------------------------------------
  728.             IF INSTR(13, Record$, "Mail received,") THEN
  729.                 IF NOT WroteMRec% THEN
  730.                     WroteMRec% = True
  731.                     GOSUB WriteMTmpRec
  732.                     GOSUB InitMRecE
  733.                     EXIT DO
  734.                 END IF
  735.             END IF
  736.  
  737.  
  738.           'CONNECT
  739.           '*******
  740.             IF INSTR(13, Record$, "CONNECT") THEN
  741.             IF FILESTAT = -1 THEN
  742.                CLOSE #CHAN
  743.                EXIT DO
  744.                ELSE
  745.                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  746.                      'Sending text in  -  skip a record
  747.                      '---------------------------------
  748.                       IF INSTR(13, Record$, "Sending text in") THEN
  749.                           IF FILESTAT = -1 THEN
  750.                               CLOSE #CHAN
  751.                               EXIT DO
  752.                               ELSE
  753.                                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  754.                           END IF
  755.                        END IF
  756.             END IF
  757.  
  758.                 Ctr% = Ctr% + 1
  759.                 CALL LocRowCol(12, 15)
  760.                 PRINT "Scanning "; LogFile$; " :"; Ctr%
  761.               
  762.               'Human caller
  763.               '------------
  764.                 IF INSTR(13, Record$, "Incoming call at") THEN
  765.                     HumanBBS& = VAL(MID$(Record$, 30))
  766.                     IF HumanBBS& = 9600 THEN
  767.                         BBS96% = BBS96% + 1
  768.                     ELSEIF HumanBBS& = 2400 THEN BBS24% = BBS24% + 1
  769.                     ELSEIF HumanBBS& = 1200 THEN BBS12% = BBS12% + 1
  770.                     ELSEIF HumanBBS& = 4800 THEN BBS48% = BBS48% + 1
  771.                     ELSEIF HumanBBS& = 7200 THEN BBS72% = BBS72% + 1
  772.                     ELSEIF HumanBBS& = 12000 THEN BBS120% = BBS120% + 1
  773.                     ELSEIF HumanBBS& = 14400 THEN BBS14% = BBS14% + 1
  774.                     ELSEIF HumanBBS& = 16800 THEN BBS16% = BBS16% + 1
  775.                     ELSEIF HumanBBS& = 19200 THEN BBS19% = BBS19% + 1
  776.                     ELSEIF HumanBBS& = 21600 THEN BBS216% = BBS216% + 1
  777.                     ELSEIF HumanBBS& = 24000 THEN BBS240% = BBS240% + 1
  778.                     ELSEIF HumanBBS& = 26400 THEN BBS264% = BBS264% + 1
  779.                     ELSEIF HumanBBS& = 28800 THEN BBS288% = BBS288% + 1
  780.                     ELSE
  781.                         BBSOther% = BBSOther% + 1
  782.                     END IF
  783.                     EXIT DO
  784.                 END IF
  785.               
  786.               'Unable to initiate transfer
  787.               '---------------------------
  788.                 IF INSTR(13, Record$, "Unable to initiate transfer") THEN
  789.                     MConnect1 = 1
  790.                     WroteMRec% = True
  791.                     GOSUB WriteMTmpRec
  792.                     GOSUB InitMRecE
  793.                     EXIT DO
  794.                 END IF
  795.               
  796.                 IF INSTR(13, Record$, "Sent") THEN
  797.                     IF ItsMail%(Record$) THEN
  798.                         subString$ = ";"
  799.                         P% = BackInstr%(0, Record$, subString$)
  800.                         IF P% THEN
  801.                             ByteOut& = VAL(MID$(Record$, P% + 1))
  802.                             MByteOut1 = MByteOut1 + ByteOut&
  803.                             subString$ = Comma
  804.                             P% = BackInstr%(0, Record$, subString$)
  805.                             OutCPS% = VAL(MID$(Record$, P% + 1))
  806.                             IF OutCPS% THEN
  807.                                 TimeOut& = ByteOut& / OutCPS%
  808.                                 MTimeOut1 = MTimeOut1 + TimeOut&
  809.                             ELSE
  810.                                 MTimeOut1 = 0
  811.                             END IF
  812.                         END IF
  813.                     ELSE
  814.                         subString$ = "\"
  815.                         P% = BackInstr%(0, Record$, subString$)
  816.                         IF P% THEN
  817.                             Temp$ = MID$(Record$, P% + 1)
  818.                             subString$ = ","
  819.                             P% = BackInstr%(0, Temp$, subString$)
  820.                             FileRecE.FileCPS = VAL(MID$(Temp$, P% + 1))
  821.                             subString$ = ";"
  822.                             P% = BackInstr%(0, Temp$, subString$)
  823.                             FileRecE.FileByteIn = VAL(MID$(Temp$, P% + 1))
  824.                             FileRecE.FileNm = LEFT$(Temp$, P% - 1)
  825.                             GOSUB WriteFTmpRec
  826.                             GOSUB InitFileRecE
  827.                         END IF
  828.                     END IF
  829.                 END IF
  830.               
  831.               'Incoming mail
  832.               '-------------
  833.                 IF INSTR(13, Record$, "Rcvd") THEN
  834.                     IF ItsMail%(Record$) THEN
  835.                         subString$ = ";"
  836.                         P% = BackInstr%(0, Record$, subString$)
  837.                         IF P% THEN
  838.                             ByteIn& = VAL(MID$(Record$, P% + 1))
  839.                             MByteIn1 = MByteIn1 + ByteIn&
  840.                             subString$ = Comma
  841.                             P% = BackInstr%(0, Record$, subString$)
  842.                             InCPS% = VAL(MID$(Record$, P% + 1))
  843.                             IF InCPS% THEN
  844.                                 TimeIn& = ByteIn& / InCPS%
  845.                                 MTimeIn1 = MTimeIn1 + TimeIn&
  846.                             ELSE
  847.                                 MTimeIn1 = 0
  848.                             END IF
  849.                         END IF
  850.                     ELSE
  851.                         subString$ = "\"
  852.                         P% = BackInstr%(0, Record$, subString$)
  853.                         IF P% THEN
  854.                             Temp$ = MID$(Record$, P% + 1)
  855.                             subString$ = ","
  856.                             P% = BackInstr%(0, Temp$, subString$)
  857.                             FileRecE.FileCPS = VAL(MID$(Temp$, P% + 1))
  858.                             subString$ = ";"
  859.                             P% = BackInstr%(0, Temp$, subString$)
  860.                             FileRecE.FileByteIn = VAL(MID$(Temp$, P% + 1))
  861.                             FileRecE.FileNm = LEFT$(Temp$, P% - 1)
  862.                             GOSUB WriteFTmpRec
  863.                             GOSUB InitFileRecE
  864.                         END IF
  865.                     END IF
  866.                   
  867.                 END IF
  868.               
  869.               'Session handshake failure
  870.               '-------------------------
  871.                 IF INSTR(12, Record$, "Session handshake failure") THEN
  872.                     IF OutgoingCall% THEN
  873.                         MConnect1 = 1
  874.                         WroteMRec% = True
  875.                         GOSUB WriteMTmpRec
  876.                         GOSUB InitMRecE
  877.                     END IF
  878.                 END IF
  879.               
  880.               'Carrier lost - Outgoing call
  881.               '----------------------------
  882.                 IF OutgoingCall% AND INSTR(13, Record$, "Carrier lost") THEN
  883.                     MConnect1 = 1
  884.                     WroteMRec% = True
  885.                     GOSUB WriteMTmpRec
  886.                     GOSUB InitMRecE
  887.                 END IF
  888.               
  889.                 IF OutgoingCall% THEN MConnect1 = 1
  890.               
  891.               'Rejecting human caller
  892.               '---------------------
  893.                 IF INSTR(13, Record$, "Rejecting human caller") THEN
  894.                     RejCaller% = RejCaller% + 1
  895.                   'Escape to the top of the loop
  896.                     EXIT DO
  897.                 END IF
  898.               
  899.               'No response from remote system
  900.               '------------------------------
  901.                 IF OutgoingCall% THEN
  902.                     IF INSTR(13, Record$, "No response from remote system") THEN
  903.                         MCallsOut1 = 1
  904.                         MConnect1 = 1
  905.                         NoResponse% = True
  906.                     END IF
  907.                 END IF
  908.               
  909.               'Outgoing call (Calling***)
  910.               '-----------------------
  911.                 IF INSTR(13, Record$, "Calling") THEN
  912.                     OutgoingCall% = True
  913.                     MCallsOut1 = 1
  914.                     subString$ = Comma
  915.                     P% = BackInstr%(0, Record$, subString$)
  916.                     IF P% THEN
  917.                         Temp$ = LEFT$(Record$, P% - 1)
  918.                         P% = BackInstr%(0, Temp$, subString$)
  919.                         MNode1 = LTRIM$(MID$(Temp$, P% + 1))
  920.                     END IF
  921.                 END IF
  922.               
  923.               'Timeout waiting for hello packet
  924.               '--------------------------------
  925.                 IF INSTR(13, Record$, "Timeout waiting for hello packet") THEN
  926.             IF FILESTAT = -1 THEN
  927.                CLOSE #CHAN
  928.                EXIT DO
  929.                ELSE
  930.                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  931.             END IF
  932.                   'this may not work all the time.
  933.                   'if the next record is the incoming Net name string then
  934.                   'it should drop down and parse it as an incoming call.  If
  935.                   'not - result will be unpredictable!
  936.                   
  937.                 END IF
  938.               
  939.               'Incoming call - Unexpected password
  940.               '-----------------------------------
  941.                 IF NOT OutgoingCall% THEN
  942.                     IF INSTR(13, Record$, "Unexpected password") THEN
  943.                         DO UNTIL MID$(Record$, 13, 19) <> "Unexpected password"
  944.             IF FILESTAT = -1 THEN
  945.                CLOSE #CHAN
  946.                EXIT DO
  947.                ELSE
  948.                   CALL InputLine(CHAN%, MAXSIZE%, FILESTAT%, Record$)
  949.             END IF
  950.                             Ctr% = Ctr% + 1
  951.                             CALL LocRowCol(12, 15)
  952.                             PRINT "Scanning "; LogFile$; " :"; Ctr%
  953.                         LOOP
  954.                     END IF
  955.                 END IF
  956.               'Drop through to parse the incoming call string
  957.               
  958.               'Incoming call (Get Node Number)
  959.               '-------------
  960.                 IF NOT OutgoingCall% THEN
  961.                     IF INSTR(1, Record$, "+") THEN
  962.                         subString$ = ","
  963.                         P% = BackInstr%(0, Record$, subString$)
  964.                         IF P% THEN
  965.                             MNode1 = LTRIM$(MID$(Record$, P% + 1))
  966.                             P% = INSTR(MNode1, "@")
  967.                             IF P% THEN
  968.                                 MNode1 = LEFT$(MNode1, P% - 1)
  969.                             END IF
  970.                             MConnect1 = 1
  971.                             MCallsIn1 = 1
  972.                             WroteMRec% = False
  973.                         END IF
  974.                     END IF
  975.                 END IF
  976.             END IF
  977.         LOOP
  978.     WEND
  979.   
  980.   'Dummy record to mark the end of file.
  981.     PRINT #MTmp%, "■■■■■■■■■■■■■■■"; Comma; 0; Comma; 0; Comma; 0; Comma; 0; Comma; 0; Comma; 0; Comma; 0
  982.     CLOSE
  983.   
  984.   '******************************
  985.   'Start the Report output work
  986.   '******************************
  987.   
  988.     Rpt% = FREEFILE
  989.   
  990.     OPEN "FDLARPT.TXT" FOR OUTPUT AS Rpt%
  991.   
  992.     PRINT #Rpt%,
  993.     PRINT #Rpt%, LogFile$;
  994.     PRINT #Rpt%, TAB(64 - LEN(FDLAVersion$)); "FDLA Version "; FDLAVersion$
  995.     IF INSTR(SysName$, "Not Defined") THEN
  996.         PRINT #Rpt%,
  997.     ELSE
  998.         P% = INSTR(SysName$, "@")
  999.         IF P% THEN
  1000.             SysName$ = MID$(SysName$, 3, P% - 3)
  1001.             PRINT #Rpt, TAB(38 - LEN(SysName$) \ 2); SysName$
  1002.         END IF
  1003.     END IF
  1004.     Temp$ = "FrontDoor Log Statistics for the period"
  1005.     PRINT #Rpt%, TAB(38 - LEN(Temp$) \ 2); Temp$
  1006.     PRINT #Rpt%, SPC(12); "From "; BeginFd$; "  to  "; EndFd$ + " " + EndTime$
  1007.     CALL ReportTPLs(1, Rpt%)
  1008.   
  1009.   '********************
  1010.   'Sort the data files
  1011.   '********************
  1012.     SortProgram$ = "QSORT"      'default
  1013.   '  SortProgram$ = "SORT"
  1014.     IF RptPtI% THEN
  1015.         SortFlag% = True
  1016.         CALL LocRowCol(13, 15)
  1017.         PRINT "Sorting..."
  1018. Sorting:
  1019.       
  1020.         SHELL SortProgram$ + "< FDLATmp.$$$ > FDLATmp.$$S"
  1021.     END IF
  1022.   
  1023.     IF RptPtII% THEN
  1024.         SHELL SortProgram$ + "< FDLATmpF.$$$ > FDLATmpF.$$S"
  1025.         CALL LocRowCol(13, 15)
  1026.         PRINT "Sorting..."
  1027.     END IF
  1028.   
  1029.     IF RptPtIV% THEN
  1030.         CALL LocRowCol(13, 15)
  1031.         PRINT "Sorting..."
  1032.         SHELL SortProgram$ + "< FDLATmpU.$$$ > FDLATmpU.$$S"
  1033.     END IF
  1034.   
  1035.     VIEW PRINT 14 TO 23
  1036.     CLS
  1037.     CALL LocRowCol(14, 15)
  1038.     PRINT "Creating output report....."
  1039.     CALL LocRowCol(15, 15)
  1040.     PRINT "Working    ";
  1041.     VIEW PRINT  'Re-set screen
  1042.   
  1043.     IF RptPtI% THEN
  1044.       
  1045.       '************************************************************
  1046.       'Merge Records from FDLATmp$$S for output report FDLARPT.TXT
  1047.       '************************************************************
  1048.       
  1049.         STmp% = FREEFILE
  1050.         OPEN "FDLATMP.$$S" FOR INPUT AS STmp%
  1051.         IF LOF(STmp%) = 0 THEN
  1052.             BEEP
  1053.             DOSError$ = ErrorCode$(4)
  1054.             CALL ErrorMessage(DOSError$)
  1055.             CALL LocRowCol(15, 15)
  1056.             PRINT "Sort file FDLATMP.$$S is Nul (Zero length). Deleting File"
  1057.             CLOSE
  1058.             KILL "FDLATMP.$$S"
  1059.             IF Exist%("FDLATMP.$$$") THEN KILL "FDLATMP.$$$"
  1060.             IF Exist%("FDLATMP?.$$?") THEN KILL "FDLATMP?.$$?"
  1061.             CALL LocRowCol(17, 19)
  1062.             COLOR 10, 0
  1063.             PRINT "You may have run out of disk space or memory."
  1064.             IF SortProgram$ = "SORT" THEN
  1065.                 CALL LocRowCol(18, 17)
  1066.                 COLOR 10, 0
  1067.                 PRINT "You are not using QSORT.  This may be the problem."
  1068.                 CALL LocRowCol(19, 13)
  1069.                 PRINT "FDLA was unable to find QSort so it tried to use DOS "; SortProgram$
  1070.                 COLOR 7, 0
  1071.                 CALL SetLevel(1)
  1072.                 END
  1073.             END IF
  1074.             CALL SetLevel(1)
  1075.             END
  1076.         END IF
  1077.         IF MkDataFile% THEN
  1078.             DatF% = FREEFILE    'Data file from
  1079.             OPEN "FDLARpt.Dat" FOR OUTPUT AS DatF%              'Part I Report
  1080.         END IF
  1081.       
  1082.       
  1083.         INPUT #STmp%, MNode1, MCallsOut1, MConnect1, MCallsIn1, MByteOut1
  1084.         INPUT #STmp%, MByteIn1, MTimeOut1, MTimeIn1
  1085.       
  1086.         INPUT #STmp%, MNode2, MCallsOut2, MConnect2, MCallsIn2, MByteout2
  1087.         INPUT #STmp%, MByteIn2, MTimeOut2, MTimeIn2
  1088.         DO
  1089.             DO
  1090.                 IF EOF(STmp%) THEN
  1091.                     EXIT DO
  1092.                 END IF
  1093.                 IF MNode1 = MNode2 THEN
  1094.                   'Combine Records
  1095.                     MCallsOut1 = MCallsOut1 + MCallsOut2
  1096.                     MConnect1 = MConnect1 + MConnect2
  1097.                     MCallsIn1 = MCallsIn1 + MCallsIn2
  1098.                     MByteOut1 = MByteOut1 + MByteout2
  1099.                     MByteIn1 = MByteIn1 + MByteIn2
  1100.                     MTimeOut1 = MTimeOut1 + MTimeOut2
  1101.                     MTimeIn1 = MTimeIn1 + MTimeIn2
  1102.                   
  1103.                   'Get the next record
  1104.                     INPUT #STmp%, MNode2, MCallsOut2, MConnect2, MCallsIn2, MByteout2
  1105.                     INPUT #STmp%, MByteIn2, MTimeOut2, MTimeIn2
  1106.                 END IF
  1107.             LOOP UNTIL MNode1 <> MNode2
  1108.           
  1109.             IF MNode1 = MNode2$ THEN
  1110.               'Combine Records
  1111.                 MCallsOut1 = MCallsOut1 + MCallsOut2
  1112.                 MConnect1 = MConnect1 + MConnect2
  1113.                 MCallsIn1 = MCallsIn1 + MCallsIn2
  1114.                 MByteOut1 = MByteOut1 + MByteout2
  1115.                 MByteIn1 = MByteIn1 + MByteIn2
  1116.                 MTimeOut1 = MTimeOut1 + MTimeOut2
  1117.                 MTimeIn1 = MTimeIn1 + MTimeIn2
  1118.               
  1119.                 GOSUB WriteRpt
  1120.             ELSE
  1121.                 GOSUB WriteRpt
  1122.             END IF
  1123.           
  1124.             MNode1 = MNode2
  1125.             MCallsOut1 = MCallsOut2
  1126.             MConnect1 = MConnect2
  1127.             MCallsIn1 = MCallsIn2
  1128.             MByteOut1 = MByteout2
  1129.             MByteIn1 = MByteIn2
  1130.             MTimeOut1 = MTimeOut2
  1131.             MTimeIn1 = MTimeIn2
  1132.             IF EOF(STmp%) THEN EXIT DO
  1133.             INPUT #STmp%, MNode2, MCallsOut2, MConnect2, MCallsIn2, MByteout2
  1134.             INPUT #STmp%, MByteIn2, MTimeOut2, MTimeIn2
  1135.         LOOP UNTIL MNode1 = "■■■■■■■■■■■■■■■"
  1136.       
  1137.       'Clear vars for later use in Part IV
  1138.         MNode1 = "": MNode2 = ""
  1139.     ELSE
  1140.         CALL ReportTPLs(4, Rpt%)
  1141.         CALL ReportTPLs(2, Rpt%)
  1142.     END IF
  1143.   
  1144.   '************************************
  1145.   'Totals for FDLARpt.txt output Part I
  1146.   '************************************
  1147.     IF RptPtI% THEN
  1148.         CALL ReportTPLs(9, Rpt%)
  1149.       
  1150.         TotMAvgCPS& = (TotMByteOut1& + TotMByteIn1&)
  1151.         IF TotMAvgCPS& > 0 AND TotTimeOutIn& > 0 THEN
  1152.             TotMAvgCPS& = (TotMByteOut1& + TotMByteIn1&) \ TotTimeOutIn&
  1153.             MTotTimeMin! = TotTimeOutIn& / 60
  1154.         END IF
  1155.         PRINT #Rpt%, Bar$; " TOTALS"; TAB(17);
  1156.         PRINT #Rpt, USING "####"; TotCallsOut1%;
  1157.         PRINT #Rpt, TAB(25);
  1158.         PRINT #Rpt, USING "####"; TotConnect1%;
  1159.         PRINT #Rpt, TAB(33);
  1160.         PRINT #Rpt, USING "###"; TotCallsIn1%;
  1161.         PRINT #Rpt, TAB(37);
  1162.         PRINT #Rpt, USING "###,###,###"; TotMByteOut1&;
  1163.         PRINT #Rpt, TAB(51);
  1164.         PRINT #Rpt, USING "###,###,###"; TotMByteIn1&;
  1165.         PRINT #Rpt, TAB(65);
  1166.         PRINT #Rpt, USING "####"; TotMAvgCPS&;
  1167.         PRINT #Rpt, TAB(70);
  1168.         PRINT #Rpt, USING "####.#"; MTotTimeMin!;
  1169.         PRINT #Rpt, Bar$
  1170.         CALL ReportTPLs(2, Rpt%)
  1171.       ' IF ExNet% THEN
  1172.       '    PRINT #Rpt,
  1173.       '    PRINT #Rpt, "NOTE: -EXN option used to exclude Net "; ExcludeNet$;
  1174.       '    PRINT #Rpt, " from Part I."
  1175.       ' END IF
  1176.     END IF
  1177.     PRINT #Rpt,
  1178.     CALL ReportTPLs(3, Rpt%)
  1179.     PrtRec% = PrtRec% + 1
  1180.     CALL PrtCtrDisp(PrtRec%)
  1181.   
  1182.   
  1183.   '**********************************************
  1184.   ' Part II of FDLARpt.txt - file out/in listing
  1185.   '**********************************************
  1186.   
  1187.     IF RptPtII% THEN
  1188.         Ctr% = 0
  1189.         TmpF% = FREEFILE
  1190.         OPEN "FDLATmpF.$$S" FOR INPUT AS #TmpF%
  1191.         DO UNTIL EOF(TmpF%)
  1192.             INPUT #TmpF%, MNode1, FileRecE.FileNm, FileRecE.FileByteOut
  1193.             INPUT #TmpF%, FileRecE.FileByteIn, FileRecE.FileCPS
  1194.             Ctr% = Ctr% + 1
  1195.             IF FileRecE.FileCPS > 0 THEN
  1196.                 FTranMin! = ((FileRecE.FileByteOut + FileRecE.FileByteIn) / FileRecE.FileCPS) / 60
  1197.                 FTranSec& = (FileRecE.FileByteOut + FileRecE.FileByteIn) \ FileRecE.FileCPS
  1198.                 TotFTranSec& = TotFTranSec& + FTranSec&
  1199.             ELSE
  1200.                 FTranMin! = 0
  1201.             END IF
  1202.             TotFByteOut& = TotFByteOut& + FileRecE.FileByteOut
  1203.             TotFByteIn& = TotFByteIn& + FileRecE.FileByteIn
  1204.             TotFTranMin! = TotFTranMin! + FTranMin!
  1205.           
  1206.             PRINT #Rpt%, Bar$; MNode1; TAB(21); FileRecE.FileNm; TAB(37);
  1207.             PRINT #Rpt%, USING "###,###,###"; FileRecE.FileByteOut;
  1208.             PRINT #Rpt%, TAB(51);
  1209.             PRINT #Rpt%, USING "###,###,###"; FileRecE.FileByteIn;
  1210.             PRINT #Rpt%, TAB(65);
  1211.             PRINT #Rpt%, USING "####"; FileRecE.FileCPS;
  1212.             PRINT #Rpt%, TAB(71);
  1213.             PRINT #Rpt%, USING "###.#"; FTranMin!;
  1214.             PRINT #Rpt%, Bar$
  1215.           
  1216.             PrtRec% = PrtRec% + 1
  1217.             CALL PrtCtrDisp(PrtRec%)
  1218.         LOOP
  1219.         CALL ReportTPLs(9, Rpt%)
  1220.         IF TotFTranSec& > 0 AND (TotFByteOut& + TotFByteIn&) > 0 THEN
  1221.             FileCPSAvg% = (TotFByteOut& + TotFByteIn&) \ TotFTranSec&
  1222.         END IF
  1223.       
  1224.         PRINT #Rpt%, Bar$; " TOTALS"; TAB(25); Ctr%;
  1225.         PRINT #Rpt%, TAB(37);
  1226.         PRINT #Rpt%, USING "###,###,###"; TotFByteOut&;
  1227.         PRINT #Rpt%, TAB(51);
  1228.         PRINT #Rpt%, USING "###,###,###"; TotFByteIn&;
  1229.         PRINT #Rpt%, TAB(65);
  1230.         PRINT #Rpt%, USING "####"; FileCPSAvg%;
  1231.         PRINT #Rpt%, TAB(70);
  1232.         PRINT #Rpt%, USING "####.#"; TotFTranMin!;
  1233.         PRINT #Rpt%, Bar$
  1234.         CALL ReportTPLs(2, Rpt%)
  1235.         PRINT #Rpt%,
  1236.       
  1237.         PrtRec% = PrtRec% + 1
  1238.         CALL PrtCtrDisp(PrtRec%)
  1239.       
  1240.     ELSE        'No activity in the log
  1241.         CALL ReportTPLs(4, Rpt%)
  1242.         CALL ReportTPLs(2, Rpt%)
  1243.     END IF
  1244.   
  1245.   '******************************
  1246.   ' Part III Session Cost output
  1247.   '******************************
  1248.   
  1249.     IF RptPtIII% THEN
  1250.         CstF% = FREEFILE
  1251.         OPEN "FDLATmpC.$$$" FOR INPUT AS #CstF%
  1252.         DO UNTIL EOF(CstF%)
  1253.             LINE INPUT #CstF%, Record$
  1254.             PRINT #Rpt, Record$
  1255.           
  1256.             PrtRec% = PrtRec% + 1
  1257.             CALL PrtCtrDisp(PrtRec%)
  1258.           
  1259.         LOOP
  1260.         CALL ReportTPLs(2, Rpt%)
  1261.         PRINT #Rpt,
  1262.     ELSE
  1263.         CALL ReportTPLs(5, Rpt%)
  1264.         CALL ReportTPLs(6, Rpt%)
  1265.         CALL ReportTPLs(2, Rpt%)
  1266.         PRINT #Rpt,
  1267.     END IF
  1268.   
  1269.   '*********************************
  1270.   ' Part IV Undialable nodes report
  1271.   '*********************************
  1272.   
  1273.     CALL ReportTPLs(7, Rpt%)
  1274.     IF RptPtIV% THEN
  1275.         Und% = FREEFILE
  1276.         OPEN "FDLATmpU.$$S" FOR INPUT AS #Und%
  1277.         Ctr% = 0
  1278.         DO UNTIL EOF(Und%)
  1279.             INPUT #Und%, MNode1
  1280.             DO
  1281.                 IF EOF(Und%) THEN
  1282.                     Ctr% = Ctr% + 1
  1283.                     GOSUB WritePtIV
  1284.                     EXIT DO
  1285.                 END IF
  1286.                 INPUT #Und%, MNode2
  1287.                 IF MNode2 = MNode1 THEN
  1288.                     MNode1 = MNode2
  1289.                 ELSE
  1290.                     Ctr% = Ctr% + 1
  1291.                     GOSUB WritePtIV
  1292.                 END IF
  1293.             LOOP UNTIL MNode1 <> MNode2
  1294.           
  1295.         LOOP
  1296.       
  1297.         IF MNode1 <> MNode2 THEN
  1298.             MNode1 = MNode2
  1299.             Ctr% = Ctr% + 1
  1300.             GOSUB WritePtIV
  1301.         END IF
  1302.       
  1303.         IF Ctr% = 0 THEN
  1304.             CALL ReportTPLs(2, Rpt%)
  1305.             PRINT #Rpt,
  1306.         ELSE
  1307.             PRINT #Rpt, TAB(76); Bar$
  1308.             CALL ReportTPLs(2, Rpt%)
  1309.             PRINT #Rpt,
  1310.         END IF
  1311.     ELSE
  1312.         CALL ReportTPLs(4, Rpt%)
  1313.         CALL ReportTPLs(2, Rpt%)
  1314.         PRINT #Rpt,
  1315.     END IF
  1316.   
  1317.   ' ****************************
  1318.   ' Part V Summary report output
  1319.   '*****************************
  1320.     CALL ReportTPLs(8, Rpt%)
  1321.   
  1322.   '28800 caller
  1323.     PRINT #Rpt, Bar$; " BBS Callers at 28800   = ";
  1324.     PRINT #Rpt, USING "####"; BBS288%;
  1325.     GOSUB ReportBar
  1326.  
  1327.    '26400 caller
  1328.     PRINT #Rpt, Bar$; "                26400   = ";
  1329.     PRINT #Rpt, USING "####"; BBS264%;
  1330.     GOSUB ReportBar
  1331.  
  1332.    '24000 caller
  1333.     PRINT #Rpt, Bar$; "                24000   = ";
  1334.     PRINT #Rpt, USING "####"; BBS240%;
  1335.     GOSUB ReportBar
  1336.  
  1337.    '21600 caller
  1338.     PRINT #Rpt, Bar$; "                21600   = ";
  1339.     PRINT #Rpt, USING "####"; BBS216%;
  1340.     PRINT #Rpt, " "; Bar$;
  1341.     PRINT #Rpt, TAB(76); Bar$
  1342.  
  1343.    '19200 caller
  1344.     PRINT #Rpt, Bar$; "                19200   = ";
  1345.     PRINT #Rpt, USING "####"; BBS19%;
  1346.     PRINT #Rpt, " "; Bar$;
  1347.     PRINT #Rpt, TAB(76); Bar$
  1348.  
  1349.    '16800 caller
  1350.     PRINT #Rpt, Bar$; "                16800   = ";
  1351.     PRINT #Rpt, USING "####"; BBS16%;
  1352.  
  1353.     PRINT #Rpt, " "; Bar$; " Message Bytes Transferred    =";
  1354.     PRINT #Rpt, USING "###,###,###"; TotMByteOut1& + TotMByteIn1&;
  1355.     PRINT #Rpt, TAB(76); Bar$
  1356.  
  1357.    '14400 caller
  1358.     PRINT #Rpt, Bar$; "                14400   = ";
  1359.     PRINT #Rpt, USING "####"; BBS14%;
  1360.     PRINT #Rpt, " "; Bar$; " File Bytes Transferred       =";
  1361.     PRINT #Rpt, USING "###,###,###"; TotFByteOut& + TotFByteIn&;
  1362.     PRINT #Rpt, TAB(76); Bar$
  1363.  
  1364.    '12000 caller
  1365.     PRINT #Rpt, Bar$; "                12000   = ";
  1366.     PRINT #Rpt, USING "####"; BBS120%;
  1367.     PRINT #Rpt, " "; Bar$;
  1368.     PRINT #Rpt, TAB(76); Bar$
  1369.   
  1370.     PRINT #Rpt, Bar$; "                 9600   = ";
  1371.     PRINT #Rpt, USING "####"; BBS96%;
  1372.     PRINT #Rpt, " "; Bar$; " TOTAL Bytes Transferred      =";
  1373.     PRINT #Rpt, USING "###,###,###"; (TotFByteOut& + TotFByteIn&) + (TotMByteOut1& + TotMByteIn1&);
  1374.     PRINT #Rpt, TAB(76); Bar$
  1375.  
  1376.    '7200 caller
  1377.     PRINT #Rpt, Bar$; "                 7200   = ";
  1378.     PRINT #Rpt, USING "####"; BBS72%;
  1379.     PRINT #Rpt, " "; Bar$;
  1380.     PRINT #Rpt, TAB(76); Bar$
  1381.  
  1382.    '4800 caller
  1383.     PRINT #Rpt, Bar$; "                 4800   = ";
  1384.     PRINT #Rpt, USING "####"; BBS48%;
  1385.     GOSUB ReportBar
  1386.   
  1387.    '2400 caller
  1388.     PRINT #Rpt, Bar$; "                 2400   = ";
  1389.     PRINT #Rpt, USING "####"; BBS24%;
  1390.     GOSUB ReportBar
  1391.  
  1392.     PRINT #Rpt, Bar$; "                 1200   = ";
  1393.     PRINT #Rpt, USING "####"; BBS12%;
  1394.     GOSUB ReportBar
  1395.  
  1396.     PRINT #Rpt, Bar$; "                 Other  = ";
  1397.     PRINT #Rpt, USING "####"; BBSOther%;
  1398.     GOSUB ReportBar
  1399.     PRINT #Rpt, Bar$; TAB(33); Bar$; " Message Connect Time         =      ";
  1400.     IF MTotTimeMin! > 0 THEN
  1401.         MTotTimeHr! = MTotTimeMin! / 60
  1402.     END IF
  1403.     PRINT #Rpt, USING "###.#"; MTotTimeHr!;
  1404.     PRINT #Rpt, Bar$
  1405.   
  1406.     PRINT #Rpt, Bar$; " TOTAL BBS Callers      = ";
  1407.     PRINT #Rpt, USING "####"; BBS16% + BBS14% + BBS96% + BBS24% + BBS12% + BBS48% + BBS72% + BBS120% + BBS19% + BBS216% + BBS240% + BBS264% + BBS288% + BBSOther%;
  1408.     PRINT #Rpt, " "; Bar$; " File Transfer Connect Time   =      ";
  1409.     IF TotFTranMin! > 0 THEN
  1410.         TotFTranHr! = TotFTranMin! / 60
  1411.     END IF
  1412.     PRINT #Rpt, USING "###.#"; TotFTranHr!;
  1413.     PRINT #Rpt, Bar$
  1414.   
  1415.     PRINT #Rpt, Bar$; TAB(33); Bar$; " TOTAL Connect Time (Hours)   =      ";
  1416.     PRINT #Rpt%, USING "###.#"; MTotTimeHr! + TotFTranHr!;
  1417.     PRINT #Rpt, Bar$
  1418.   
  1419.     PRINT #Rpt, Bar$; " Rejected BBS Calls     = ";
  1420.     PRINT #Rpt, USING "####"; RejCaller%;
  1421.     PRINT #Rpt, " "; Bar$; " TOTAL Network Session Costs  =   ";
  1422.     PRINT #Rpt, USING "$####.##"; TotSessCost!;
  1423.     PRINT #Rpt, Bar$
  1424.   
  1425.     PRINT #Rpt, Bar$;
  1426.     IF HighAscii% THEN
  1427.         PRINT #Rpt, TAB(33); "├──────────────────────────────────────────┤"
  1428.     ELSE
  1429.         PRINT #Rpt, TAB(33); "+------------------------------------------+"
  1430.     END IF
  1431.   
  1432.     PRINT #Rpt, Bar$; TAB(33); Bar$; " Unsuccessful Connect Attempts=      ";
  1433.     PRINT #Rpt, USING "#####"; (TotCallsOut1% + TotCallsIn1%) - TotConnect1%;
  1434.     PRINT #Rpt, Bar$
  1435.     IF HighAscii% THEN
  1436.         PRINT #Rpt, "└───────────────────────────────┴──────────────────────────────────────────┘"
  1437.     ELSE
  1438.       ' PRINT #Rpt, "+-------------------------------+------------------------------------------+"
  1439.         PRINT #Rpt, ">===============================+==========================================+"
  1440.     END IF
  1441.     CLOSE
  1442.   
  1443.     CALL LocRowCol(16, 15)
  1444.     PRINT "Finished Output: ";
  1445.     COLOR 15, 0
  1446.     PRINT "FDLARpt.Txt"
  1447.     COLOR 7, 0
  1448.   
  1449.     IF DelTempFiles% THEN
  1450.         KILL "FDLATmp.$$$"
  1451.         KILL "FDLATmpF.$$$"
  1452.         KILL "FDLATmpU.$$$"
  1453.         KILL "FDLATmpC.$$$"
  1454.         IF RptPtI% THEN
  1455.             KILL "FDLATmp.$$S"
  1456.         END IF
  1457.         IF RptPtII% THEN
  1458.             KILL "FDLATmpF.$$S"
  1459.         END IF
  1460.         IF RptPtIV% THEN
  1461.             KILL "FDLATmpU.$$S"
  1462.         END IF
  1463.     END IF
  1464.   
  1465.     VIEW PRINT  'Re set screen
  1466.   
  1467.     IF DispRpt% THEN
  1468.         CALL DisplayReport
  1469.       'Program ends in Sub
  1470.     END IF
  1471.     CALL LocRowCol(24, 1)
  1472.   
  1473.     END
  1474.   
  1475.   '**********************
  1476.   ' Program error traps
  1477.   '**********************
  1478. ErrHandler:
  1479.     IF SortFlag% AND ERR = 53 AND SortProgram$ = "QSORT" THEN
  1480.         SortProgram$ = "SORT"
  1481.         RESUME Sorting
  1482.     ELSE
  1483.     PRINT
  1484.     BEEP
  1485.     VIEW PRINT
  1486.     DOSError$ = ErrorCode$(ERR)
  1487.     CALL ErrorMessage(DOSError$)
  1488.     CALL SetLevel(1)
  1489.     END
  1490.     END IF
  1491.   '********************
  1492.   ' Sub-Routines
  1493.   '********************
  1494.  
  1495. ReportBar:
  1496.     IF HighAscii% THEN
  1497.         PRINT #Rpt, " ├──────────────────────────────────────────┤"
  1498.     ELSE
  1499.         PRINT #Rpt, " +------------------------------------------+"
  1500.     END IF
  1501.     RETURN
  1502.    
  1503.   'Write FDLATmp.$$$ mail record
  1504.   
  1505. WriteMTmpRec:
  1506.     IF ExNet% THEN
  1507.        FOR X% = 1 TO Last%
  1508.            IF INSTR(MNode1, ExcludNet$(X%)) THEN
  1509.                ChopNet% = True
  1510.                EXIT FOR
  1511.            END IF
  1512.        NEXT
  1513.     END IF
  1514.     IF ChopNet% THEN
  1515.         ChopNet% = False
  1516.         GOSUB InitMRecE
  1517.         RETURN
  1518.     END IF
  1519.     RptPtI% = True
  1520.     IF MConnect1 = 1 AND MCallsOut1 = 0 THEN
  1521.         MCallsIn1 = 1
  1522.     END IF
  1523.     PRINT #MTmp%, MNode1; Comma; MCallsOut1; Comma;
  1524.     PRINT #MTmp%, MConnect1; Comma; MCallsIn1; Comma;
  1525.     PRINT #MTmp%, MByteOut1; Comma; MByteIn1; Comma;
  1526.     PRINT #MTmp%, MTimeOut1;
  1527.     PRINT #MTmp%, Comma;
  1528.     PRINT #MTmp%, MTimeIn1
  1529.     RETURN
  1530.   
  1531. WriteFTmpRec:
  1532.  
  1533.     IF ExNet% THEN
  1534.        FOR X% = 1 TO Last%
  1535.            IF INSTR(MNode1, ExcludNet$(X%)) THEN
  1536.                ChopNet% = True
  1537.                EXIT FOR
  1538.            END IF
  1539.        NEXT
  1540.     END IF
  1541.     IF ChopNet% THEN
  1542.         ChopNet% = False
  1543.         GOSUB InitFileRecE
  1544.         RETURN
  1545.     END IF
  1546.  
  1547.     IF ExFil% THEN
  1548.        FOR X% = 1 TO LastF%
  1549.            IF INSTR(FileRecE.FileNm, ExcludFiles$(X%)) THEN
  1550.                ChopFile% = True
  1551.                EXIT FOR
  1552.            END IF
  1553.        NEXT
  1554.     END IF
  1555.     IF ChopFile% THEN
  1556.         ChopFile% = False
  1557.         GOSUB InitFileRecE
  1558.         RETURN
  1559.     END IF
  1560.  
  1561.     RptPtII% = True
  1562.     PRINT #FTmp%, MNode1; Comma; FileRecE.FileNm; Comma;
  1563.     PRINT #FTmp%, FileRecE.FileByteOut; Comma; FileRecE.FileByteIn; Comma;
  1564.     PRINT #FTmp%, FileRecE.FileCPS
  1565.     RETURN
  1566.   
  1567. WriteUTmpRec:                   'Undialable nodes
  1568.  
  1569.     IF ExNet% THEN
  1570.        FOR X% = 1 TO Last%
  1571.            IF INSTR(MNode1, ExcludNet$(X%)) THEN
  1572.                ChopNet% = True
  1573.                EXIT FOR
  1574.            END IF
  1575.        NEXT
  1576.     END IF
  1577.     IF ChopNet% THEN
  1578.         ChopNet% = False
  1579.         RETURN
  1580.     END IF
  1581.  
  1582.     RptPtIV% = True
  1583.     PRINT #UTmp%, MNode1
  1584.     RETURN
  1585.   
  1586. WriteRpt:
  1587.   'Write FDLARpt.Txt detail lines
  1588.   'A Nul record slipped in
  1589.     IF MCallsOut1 + MConnect1 + MCallsIn1 + MByteOut1 + MByteIn1 + MTimeOut1 + MTimeIn1 = 0 THEN
  1590.         RETURN
  1591.     END IF
  1592.   
  1593.     MByteOutIn1& = MByteOut1 + MByteIn1
  1594.     MTimeOutIn1% = MTimeOut1 + MTimeIn1
  1595.   
  1596.     IF MByteOutIn1& > 0 AND MTimeOutIn1% > 0 THEN
  1597.         MAvgCPS1% = MByteOutIn1& \ MTimeOutIn1%
  1598.         MtimeMin1! = MTimeOutIn1% / 60
  1599.     END IF
  1600.   
  1601.   'Data file from Part I of the report - FDLARpt.Dat
  1602.     IF MkDataFile% THEN
  1603.         PRINT #DatF%, MNode1; Comma; MCallsOut1; Comma; MConnect1; Comma; MCallsIn1; Comma;
  1604.         PRINT #DatF%, MByteOut1; Comma; MByteIn1; Comma; MTimeOut1; Comma;
  1605.         PRINT #DatF%, MTimeIn1; Comma; MByteOutIn1&; Comma; MTimeOutIn1%; Comma;
  1606.         PRINT #DatF%, MAvgCPS1%; Comma; MtimeMin1!
  1607.     END IF
  1608.   
  1609.   'Output to FDLARpt.txt of Part I data
  1610.   'collected from FDLATmp.$$S
  1611.   
  1612.     PRINT #Rpt, Bar$; MNode1; TAB(18);
  1613.     PRINT #Rpt, USING "####"; MCallsOut1;
  1614.     PRINT #Rpt, TAB(26);
  1615.     PRINT #Rpt, USING "###"; MConnect1;
  1616.     PRINT #Rpt, TAB(33);
  1617.     PRINT #Rpt, USING "###"; MCallsIn1;
  1618.     PRINT #Rpt, TAB(37);
  1619.     PRINT #Rpt, USING "###,###,###"; MByteOut1;
  1620.     PRINT #Rpt, TAB(51);
  1621.     PRINT #Rpt, USING "###,###,###"; MByteIn1;
  1622.     PRINT #Rpt, TAB(65);
  1623.     PRINT #Rpt, USING "####"; MAvgCPS1%;
  1624.     PRINT #Rpt, TAB(71);
  1625.     PRINT #Rpt, USING "###.#"; MtimeMin1!;
  1626.     PRINT #Rpt, Bar$
  1627.   
  1628.     PrtRec% = PrtRec% + 1
  1629.     CALL PrtCtrDisp(PrtRec%)
  1630.   
  1631.   'Totals
  1632.     TotCallsOut1% = TotCallsOut1% + MCallsOut1
  1633.     TotConnect1% = TotConnect1% + MConnect1
  1634.     TotCallsIn1% = TotCallsIn1% + MCallsIn1
  1635.     TotMByteOut1& = TotMByteOut1& + MByteOut1
  1636.     TotMByteIn1& = TotMByteIn1& + MByteIn1
  1637.     TotTimeOutIn& = TotTimeOutIn& + MTimeOutIn1%
  1638.   
  1639.     MByteOutIn1& = 0
  1640.     MTimeOutIn1% = 0
  1641.     MAvgCPS1% = 0
  1642.     MtimeMin1! = 0
  1643.     RETURN
  1644.   
  1645. WritePtIV:
  1646.     SELECT CASE Ctr%
  1647.     CASE IS = 1
  1648.         PRINT #Rpt%, Bar$; MNode1; TAB(22);
  1649.     CASE IS = 2
  1650.         PRINT #Rpt%, MNode1; TAB(42);
  1651.     CASE IS = 3
  1652.         PRINT #Rpt%, MNode1;
  1653.     CASE IS = 4
  1654.         Node1$ = RTRIM$(MNode1)
  1655.         PRINT #Rpt%, TAB(76 - LEN(Node1$)); Node1$; TAB(76); Bar$
  1656.         Ctr% = 0
  1657.     END SELECT
  1658.   
  1659.     PrtRec% = PrtRec% + 1
  1660.     CALL PrtCtrDisp(PrtRec%)
  1661.   
  1662.     RETURN
  1663.   
  1664. InitMRecE:
  1665.     MNode1 = "Unknown"
  1666.     MCallsOut1 = 0
  1667.     MConnect1 = 0
  1668.     MCallsIn1 = 0
  1669.     MByteOut1 = 0
  1670.     MByteIn1 = 0
  1671.     MTimeOut1 = 0
  1672.     MTimeIn1 = 0
  1673.   
  1674.     OutgoingCall% = False
  1675.     InCPS% = 0
  1676.     OutCPS% = 0
  1677.     ByteIn& = 0
  1678.     ByteOut& = 0
  1679.     TimeIn& = 0
  1680.     TimeOut& = 0
  1681.     RETURN
  1682.   
  1683. InitFileRecE:
  1684.     FileRecE.FileNm = "Unknown"
  1685.     FileRecE.FileByteOut = 0
  1686.     FileRecE.FileByteIn = 0
  1687.     FileRecE.FileCPS = 0
  1688.     RETURN
  1689.  
  1690.     FUNCTION BackInstr% (Start%, searchString$, subString$)
  1691.         IF Start% = 0 THEN Start% = 1
  1692.         n% = INSTR(Start%, searchString$, subString$)
  1693.         a% = n%
  1694.         DO WHILE n%
  1695.             n% = n% + 1
  1696.             n% = INSTR(n%, searchString$, subString$)
  1697.             IF n% THEN a% = n%
  1698.         LOOP
  1699.         BackInstr% = a%
  1700.     END FUNCTION
  1701.  
  1702.     SUB Copyright
  1703.       'Opening Screen
  1704.         CLS
  1705.         COLOR 15, 0
  1706.         Title$ = Copyright1$ + FDLAVersion$
  1707.         PRINT TAB(40 - LEN(Title$) / 2); Title$
  1708.         PRINT TAB(40 - LEN(Copyright2$) / 2); Copyright2$
  1709.         PRINT TAB(40 - LEN(Copyright3$) / 2); Copyright3$
  1710.         COLOR 7, 0
  1711.       
  1712.     END SUB
  1713.  
  1714.     SUB DisplayReport
  1715.         CLS
  1716.         COLOR 10, 0
  1717.         FILE$ = "FDLARpt.Txt"
  1718.         Escape = False
  1719.       
  1720.         Count = LineCount%(FILE$, SPACE$(4096))
  1721.         DRpt% = FREEFILE
  1722.         OPEN FILE$ FOR INPUT AS DRpt%
  1723.         REDIM Seeks&(1 TO Count)                ' Max number of lines
  1724.         CurSeek& = 1
  1725.         NumLines = 0
  1726.         DO UNTIL EOF(1)
  1727.             LINE INPUT #DRpt%, TEXT$
  1728.             NumLines = NumLines + 1
  1729.             Seeks&(NumLines) = CurSeek&         ' Save starting position
  1730.             CurSeek& = CurSeek& + LEN(TEXT$) + 2                ' Next position - 2 is
  1731.         LOOP    ' for C/R & LF
  1732.       
  1733.         CurCol = 1              ' Current Column
  1734.         SeekEl = 1              ' Current line
  1735.         Escape = False
  1736.         DO
  1737.             GOSUB LoadAndDisplay
  1738.             GOSUB KeyProcess
  1739.         LOOP UNTIL Escape
  1740.         CLOSE DRpt%
  1741.       ' CLS
  1742.       ' CALL LocRowCol(24, 1)
  1743.         CALL ScrnRest(1, 1, 25, 80, SEG Scrn%(1), -1)
  1744.         END
  1745. LoadAndDisplay:
  1746.         SEEK #DRpt%, Seeks&(SeekEl)
  1747.         FOR i = 1 TO 24
  1748.             IF NOT EOF(DRpt%) THEN LINE INPUT #DRpt%, TEXT$ ELSE TEXT$ = ""
  1749.             Strg$ = SPACE$(80)
  1750.             IF LEN(TEXT$) < CurCol THEN TEXT$ = TEXT$ + SPACE$(CurCol - LEN(TEXT$))
  1751.             LSET Strg$ = MID$(TEXT$, CurCol)
  1752.             LOCATE i, 1, 0: PRINT Strg$;
  1753.         NEXT i
  1754.         RETURN
  1755.       
  1756.       
  1757. KeyProcess:
  1758.         a$ = INKEY$: IF a$ = "" THEN GOTO KeyProcess
  1759.         SELECT CASE a$
  1760.         CASE CHR$(27): Escape = True            ' ESC
  1761.         CASE CHR$(88): Escape = True
  1762.         CASE CHR$(120): Escape = True
  1763.         CASE CHR$(0) + CHR$(72) ' Up Arrow
  1764.             SeekEl = SeekEl - 1
  1765.             IF SeekEl < 1 THEN SeekEl = 1: GOTO KeyProcess
  1766.         CASE CHR$(0) + CHR$(80) ' Dn Arrow
  1767.             SeekEl = SeekEl + 1
  1768.             IF SeekEl + 23 > NumLines THEN SeekEl = SeekEl - 1: GOTO KeyProcess
  1769.         CASE CHR$(0) + CHR$(77) ' Right Arrow
  1770.             CurCol = CurCol + 1
  1771.         CASE CHR$(0) + CHR$(75) ' Left Arrow
  1772.             CurCol = CurCol - 1
  1773.             IF CurCol < 1 THEN CurCol = 1: GOTO KeyProcess
  1774.         CASE CHR$(0) + CHR$(73) ' Page Up
  1775.             SeekEl = SeekEl - 24
  1776.             IF SeekEl < 1 THEN SeekEl = 1
  1777.         CASE CHR$(0) + CHR$(81) ' Page Dn
  1778.             SeekEl = SeekEl + 24
  1779.             IF SeekEl > NumLines THEN
  1780.                 SeekEl = NumLines - 23: GOTO KeyProcess
  1781.             END IF
  1782.         CASE CHR$(0) + CHR$(71) ' Home
  1783.             SeekEl = 1
  1784.         CASE CHR$(0) + CHR$(79) ' End
  1785.             SeekEl = NumLines - 23
  1786.             IF SeekEl < 1 THEN SeekEl = 1: GOTO KeyProcess
  1787.         CASE ELSE
  1788.             GOTO KeyProcess
  1789.         END SELECT
  1790.         RETURN
  1791.       
  1792.     END SUB
  1793.  
  1794.     FUNCTION ErrorCode$ (Code%)
  1795.       
  1796.         SELECT CASE Code%
  1797.         CASE IS = 2
  1798.             ErrorCode$ = "Syntax error"
  1799.         CASE IS = 3
  1800.             ErrorCode$ = "RETURN without GOSUB"
  1801.         CASE IS = 4
  1802.             ErrorCode$ = "Out of DATA"
  1803.         CASE IS = 5
  1804.             ErrorCode$ = "Illegal function call"
  1805.         CASE IS = 6
  1806.             ErrorCode$ = "Overflow"
  1807.         CASE IS = 7
  1808.             ErrorCode$ = "Out of memory"
  1809.         CASE IS = 9
  1810.             ErrorCode$ = "Subscript out of range"
  1811.         CASE IS = 10
  1812.             ErrorCode$ = "Duplicate definition"
  1813.         CASE IS = 11
  1814.             ErrorCode$ = "Division by zero"
  1815.         CASE IS = 13
  1816.             ErrorCode$ = "Type mismatch"
  1817.         CASE IS = 14
  1818.             ErrorCode$ = "Out of string space"
  1819.         CASE IS = 16
  1820.             ErrorCode$ = "String formula too complex"
  1821.         CASE IS = 19
  1822.             ErrorCode$ = "No RESUME"
  1823.         CASE IS = 20
  1824.             ErrorCode$ = "RESUME without error"
  1825.         CASE IS = 24
  1826.             ErrorCode$ = "Device Timeout"
  1827.         CASE IS = 25
  1828.             ErrorCode$ = "Device Fault"
  1829.         CASE IS = 27
  1830.             ErrorCode$ = "Out of paper"
  1831.         CASE IS = 39
  1832.             ErrorCode$ = "CASE ELSE expected"
  1833.         CASE IS = 40
  1834.             ErrorCode$ = "Variable required"
  1835.         CASE IS = 50
  1836.             ErrorCode$ = "FIELD overflow"
  1837.         CASE IS = 51
  1838.             ErrorCode$ = "Internal error"
  1839.         CASE IS = 52
  1840.             ErrorCode$ = "Bad file name or number"
  1841.         CASE IS = 53
  1842.             ErrorCode$ = "File not found"
  1843.         CASE IS = 54
  1844.             ErrorCode$ = "Bad file mode"
  1845.         CASE IS = 55
  1846.             ErrorCode$ = "File already open"
  1847.         CASE IS = 56
  1848.             ErrorCode$ = "FIELD Statement active"
  1849.         CASE IS = 57
  1850.             ErrorCode$ = "Device I/O error"
  1851.         CASE IS = 58
  1852.             ErrorCode$ = "File already exists"
  1853.         CASE IS = 59
  1854.             ErrorCode$ = "Bad Record Length"
  1855.         CASE IS = 61
  1856.             ErrorCode$ = "Disk full"
  1857.         CASE IS = 62
  1858.             ErrorCode$ = "Input past end of file"
  1859.         CASE IS = 63
  1860.             ErrorCode$ = "Bad record number"
  1861.         CASE IS = 64
  1862.             ErrorCode$ = "Bad file name"
  1863.         CASE IS = 67
  1864.             ErrorCode$ = "Too many files"
  1865.         CASE IS = 68
  1866.             ErrorCode$ = "Device unavailable"
  1867.         CASE IS = 69
  1868.             ErrorCode$ = "Communication-buffer overflow"
  1869.         CASE IS = 70
  1870.             ErrorCode$ = "Permission denied"
  1871.         CASE IS = 71
  1872.             ErrorCode$ = "Disk not ready"
  1873.         CASE IS = 72
  1874.             ErrorCode$ = "Media error"
  1875.         CASE IS = 73
  1876.             ErrorCode$ = "Advanced feature unavailable"
  1877.         CASE IS = 74
  1878.             ErrorCode$ = "Rename accross disks"
  1879.         CASE IS = 75
  1880.             ErrorCode$ = "Path/File access error"
  1881.         CASE IS = 76
  1882.             ErrorCode$ = "Path not found"
  1883.         CASE ELSE
  1884.             ErrorCode$ = "Unknown error"
  1885.         END SELECT
  1886.     END FUNCTION
  1887.  
  1888.     SUB ErrorMessage (message$) STATIC
  1889.       
  1890.       ' Define color constants
  1891.         CONST BLACK = 0
  1892.         CONST BLUE = 1
  1893.         CONST GREEN = 2
  1894.         CONST CYAN = 3
  1895.         CONST RED = 4
  1896.         CONST MAGENTA = 5
  1897.         CONST BROWN = 6
  1898.         CONST WHITE = 7
  1899.         CONST BRIGHT = 8
  1900.         CONST BLINK = 16
  1901.         CONST Yellow = BROWN + BRIGHT
  1902.       
  1903.       ' Trim off spaces on each end of message
  1904.         message$ = LTRIM$(RTRIM$(message$))
  1905.       
  1906.       ' Make message length an odd number
  1907.         IF LEN(message$) MOD 2 = 0 THEN
  1908.             message$ = message$ + " "
  1909.         END IF
  1910.       
  1911.       ' Minimum length of message is 9 characters
  1912.         DO WHILE LEN(message$) < 9
  1913.             message$ = " " + message$ + " "
  1914.         LOOP
  1915.       
  1916.       ' Maximum length of message is 75
  1917.         message$ = LEFT$(message$, 75)
  1918.       
  1919.       ' Initialization of display
  1920.         SCREEN 0
  1921.         WIDTH 80
  1922.         CLS
  1923.         CALL Copyright
  1924.         COLOR WHITE + BRIGHT, BLACK
  1925.         LOCATE 6, 10
  1926.         PRINT "Darn.  I think we just blew it!"
  1927.       
  1928.       
  1929.       ' Calculate screen locations
  1930.         lm% = LEN(message$)
  1931.         col% = 38 - lm% \ 2
  1932.       
  1933.       ' Create the error box
  1934.         COLOR RED + BRIGHT, RED
  1935.         LOCATE 9, col%
  1936.         PRINT CHR$(201); STRING$(lm% + 2, 205); CHR$(187)
  1937.         LOCATE 10, col%
  1938.         PRINT CHR$(186); SPACE$(lm% + 2); CHR$(186)
  1939.         LOCATE 11, col%
  1940.         PRINT CHR$(186); SPACE$(lm% + 2); CHR$(186)
  1941.         LOCATE 12, col%
  1942.         PRINT CHR$(200); STRING$(lm% + 2, 205); CHR$(188)
  1943.       
  1944.       ' The title
  1945.         COLOR CYAN + BRIGHT, RED
  1946.         LOCATE 10, 36
  1947.         PRINT "* ERROR *";
  1948.       
  1949.       ' The message$
  1950.         COLOR Yellow, RED
  1951.         LOCATE 11, col% + 2
  1952.         PRINT message$;
  1953.      '  CLOSE
  1954.      '  KILL "*.$$?"
  1955.        END
  1956.       ' System will prompt for "any key"
  1957.         COLOR WHITE, BLACK
  1958.       '  LOCATE 22, 1
  1959.       ' LOCATE 15, 10
  1960.       ' PRINT "If you are unable to take corrective action with the error message"
  1961.       ' LOCATE 16, 10
  1962.       ' PRINT "stated above, please contact me via NetMail at FidoNet Node 1:134/75."
  1963.       ' LOCATE 17, 10
  1964.       ' PRINT "It's always appreciated if you send me your Binkley log file also."
  1965.       ' LOCATE 19, 10
  1966.       ' PRINT "If it's possible that you have memory problems, I highly recommend"
  1967.       ' LOCATE 20, 10
  1968.       ' PRINT "you try QSort (by Ben Baker) rather than the normal MS DOS Sort."
  1969.       ' SYSTEM
  1970.       
  1971.     END SUB
  1972.  
  1973.     SUB Help
  1974.         PRINT STRING$(79, "─")
  1975.         COLOR 15, 0
  1976.         PRINT "Use:   ";
  1977.         COLOR 7, 0
  1978.         PRINT "FDLA [<-switch>] [LOG=logfilename]"
  1979.         PRINT
  1980.         PRINT SPC(7); "All switches are optional as is the log filename and may be given"
  1981.         PRINT SPC(7); "in any order.  If no Command Line parameters are given, FDLA defaults"
  1982.         PRINT SPC(7); "to creating FDLARpt.Txt and uses the Front Door log (FD.LOG) in the    "
  1983.         PRINT SPC(7); "default directory."
  1984.         COLOR 15, 0
  1985.         PRINT "Switches:"
  1986.         COLOR 7, 0
  1987.         PRINT TAB(8); "= No swich will produce FDLARpt.Txt and exit FDLA."
  1988.         PRINT " -D    = Make a data file FDLARpt.Dat from Part I of the report."
  1989.         PRINT " -H    = This brief help screen."
  1990.         PRINT " -EXN  = -EXN,Zone:Node (ie -EXN,1:134,2:). Exclusions from FDLARpt.*"
  1991.         PRINT " -KTF  = Don't delete created temp files (.$$$, .$$S)."
  1992.         PRINT " -L    = Produce FDLARpt.Txt and list it to the screen."
  1993.         PRINT " -LL   = List the last created FDLARpt.Txt file to the screen."
  1994.         PRINT " -NHA  = Don't use high ascii characters in FDLARpt.Txt."
  1995.         PRINT " -SN   = Configure FDLA.EXE to display your System Name on the output report."
  1996.         PRINT " -SUP  = -SUP,Filename(s) (ie -SUP,.REQ,.TIC). Exclusions from Pt FDLARpt.*"
  1997.         PRINT " LOG=  = Log path\log filename.  Optional if FD.LOG in default directory."
  1998.         PRINT STRING$(79, "─")
  1999.       
  2000.     END SUB
  2001.  
  2002.         SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$) STATIC
  2003.  
  2004.  
  2005.         '[]=============================================================[]
  2006.         '[]        Inputs a line of text from the specified file        []
  2007.         '[]=============================================================[]
  2008.  
  2009.         STATIC TOTBYTES&        ' Total #bytes in file
  2010.         STATIC BYTES&           ' #Bytes read so far
  2011.         STATIC SEEKPOS&         ' Seek position in file
  2012.         STATIC SPOS             ' Start of line in buffer
  2013.  
  2014.         ' Initialize if this is the first call
  2015.  
  2016.         IF STATUS = 1 THEN
  2017.             STATUS = 0
  2018.             TOTBYTES& = LOF(IOCHAN)
  2019.             BYTES& = 0
  2020.             SEEKPOS& = 1
  2021.             BUFFER$ = STRING$(BUFSIZE, 0)
  2022.             SPOS = 1
  2023.         END IF
  2024.  
  2025.         EPOS = INSTR(SPOS, BUFFER$, CRLF$)
  2026.         IF EPOS <> 0 THEN
  2027.             '
  2028.             ' Easy - have a full line
  2029.             '
  2030.             TEXT$ = MID$(BUFFER$, SPOS, EPOS - SPOS)
  2031.         ELSE
  2032.             ' Partial line - read the next block
  2033.             '  and assemble the full line
  2034.             '
  2035.             IF LEFT$(BUFFER$, 1) = CHR$(0) THEN
  2036.                 TEXT$ = ""
  2037.             ELSE
  2038.                 TEXT$ = MID$(BUFFER$, SPOS, BUFSIZE - SPOS + 1)
  2039.             END IF
  2040.             IF (SEEKPOS& + BUFSIZE) > TOTBYTES& THEN
  2041.                 BUFSIZE = TOTBYTES& - SEEKPOS& + 1
  2042.                 BUFFER$ = STRING$(BUFSIZE, 0)
  2043.             END IF
  2044.             GET #IOCHAN, SEEKPOS&, BUFFER$
  2045.             BYTES& = BYTES& + BUFSIZE
  2046.             SEEKPOS& = SEEKPOS& + BUFSIZE
  2047.             IF BYTES& = TOTBYTES& THEN
  2048.                 '
  2049.                 ' Last block needs ending CRLF
  2050.                 '
  2051.                 IF RIGHT$(BUFFER$, 2) <> CRLF$ THEN
  2052.                     BUFFER$ = BUFFER$ + CRLF$
  2053.                     BUFSIZE = BUFSIZE + 2
  2054.                 END IF
  2055.             END IF
  2056.             IF RIGHT$(TEXT$, 1) = CR$ THEN
  2057.                 '
  2058.                 ' Special case - CR at end of previous block
  2059.                 '
  2060.                 TEXT$ = LEFT$(TEXT$, LEN(TEXT$) - 1)
  2061.                 EPOS = 0
  2062.             ELSE
  2063.                 EPOS = INSTR(1, BUFFER$, CRLF$)
  2064.                 TEXT$ = TEXT$ + MID$(BUFFER$, 1, EPOS - 1)
  2065.             END IF
  2066.         END IF
  2067.  
  2068.         ' Point to start of next line
  2069.  
  2070.         SPOS = EPOS + 2
  2071.  
  2072.         ' All done? If so set status and deallocate buffer
  2073.  
  2074.         IF (BYTES& = TOTBYTES& AND EPOS = (BUFSIZE - 1)) THEN
  2075.             BUFFER$ = "" ' This doesn't ERASE
  2076.             STATUS = -1
  2077.         END IF
  2078.  
  2079.         END SUB
  2080.  
  2081.     FUNCTION ItsMail% (Work$)
  2082.       
  2083.       'Determine by the extension on the filename is it's
  2084.       'Mail or a file of some other flavour.
  2085.       
  2086.         P% = QInstrB%(LEN(Work$) - 1, Work$, ".")
  2087.         IF P% THEN
  2088.             Extension$ = MID$(Work$, P% + 1, 2)
  2089.             SELECT CASE Extension$
  2090.             CASE IS = "MO", "TU", "WE", "TH", "FR", "SA", "SU", "OU", "PK", "CU", "HU", "DU"
  2091.                 ItsMail% = True
  2092.             CASE ELSE
  2093.                 ItsMail% = False
  2094.             END SELECT
  2095.         END IF
  2096.     END FUNCTION
  2097.  
  2098.     SUB LocRowCol (X%, Y%)
  2099.         LOCATE X%, Y%
  2100.     END SUB
  2101.  
  2102.   ' ************************************************
  2103.   ' **  Name:          ParseLine                  **
  2104.   ' **  Type:          Subprogram                 **
  2105.   ' **  Module:        PARSE.BAS                  **
  2106.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  2107.   ' ************************************************
  2108.   '
  2109.   ' Breaks a string into an array of words, as defined
  2110.   ' by any characters listed in sep$.
  2111.   '
  2112.   ' EXAMPLE OF USE:  ParseLine x$, sep$, a$()
  2113.   ' PARAMETERS:      x$      String to be parsed
  2114.   '                  sep$    List of characters defined as word separators
  2115.   '                  a$()    Returned array of words
  2116.   ' VARIABLES:       t$      Temporary work string
  2117.   '                  i%      Index to array entries
  2118.   ' MODULE LEVEL
  2119.   '   DECLARATIONS:  DECLARE SUB ParseLine (x$, sep$, a$())
  2120.   '
  2121.     SUB ParseLine (X$, sep$, a$()) STATIC
  2122.         t$ = X$
  2123.         FOR i% = LBOUND(a$) TO UBOUND(a$)
  2124.             ParseWord t$, sep$, a$(i%)
  2125.             IF a$(i%) = "" THEN
  2126.                 EXIT FOR
  2127.             END IF
  2128.         NEXT i%
  2129.         t$ = ""
  2130.     END SUB
  2131.  
  2132.   ' ************************************************
  2133.   ' **  Name:          ParseWord                  **
  2134.   ' **  Type:          Subprogram                 **
  2135.   ' **  Module:        PARSE.BAS                  **
  2136.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  2137.   ' ************************************************
  2138.   '
  2139.   ' Breaks off the first word in a$, as delimited by
  2140.   ' any characters listed in sep$.
  2141.   '
  2142.   ' EXAMPLE OF USE:  ParseWord a$, sep$, word$
  2143.   ' PARAMETERS:      a$         String to be parsed
  2144.   '                  sep$       List of characters defined as word separators
  2145.   '                  word$      Returned first word parsed from a$
  2146.   ' VARIABLES:       lena%      Length of a$
  2147.   '                  i%         Looping index
  2148.   '                  j%         Looping index
  2149.   '                  k%         Looping index
  2150.   ' MODULE LEVEL
  2151.   '   DECLARATIONS:  DECLARE SUB ParseWord (a$, sep$, word$)
  2152.   '
  2153.     SUB ParseWord (a$, sep$, word$) STATIC
  2154.         word$ = ""
  2155.         lena% = LEN(a$)
  2156.         IF a$ = "" THEN
  2157.             EXIT SUB
  2158.         END IF
  2159.         FOR i% = 1 TO lena%
  2160.             IF INSTR(sep$, MID$(a$, i%, 1)) = 0 THEN
  2161.                 EXIT FOR
  2162.             END IF
  2163.         NEXT i%
  2164.         FOR j% = i% TO lena%
  2165.             IF INSTR(sep$, MID$(a$, j%, 1)) THEN
  2166.                 EXIT FOR
  2167.             END IF
  2168.         NEXT j%
  2169.         FOR k% = j% TO lena%
  2170.             IF INSTR(sep$, MID$(a$, k%, 1)) = 0 THEN
  2171.                 EXIT FOR
  2172.             END IF
  2173.         NEXT k%
  2174.         IF i% > lena% THEN
  2175.             a$ = ""
  2176.             EXIT SUB
  2177.         END IF
  2178.         IF j% > lena% THEN
  2179.             word$ = MID$(a$, i%)
  2180.             a$ = ""
  2181.             EXIT SUB
  2182.         END IF
  2183.         word$ = MID$(a$, i%, j% - i%)
  2184.         IF k% > lena% THEN
  2185.             a$ = ""
  2186.         ELSE
  2187.             a$ = MID$(a$, k%)
  2188.         END IF
  2189.     END SUB
  2190.  
  2191.     SUB PrtCtrDisp (PrtRec%) STATIC
  2192.         SELECT CASE PrtRec%
  2193.         CASE IS = 1             ' 3
  2194.             CALL LocRowCol(15, 15)
  2195.             PRINT "Working    |"
  2196.         CASE IS = 2             '6
  2197.             CALL LocRowCol(15, 15)
  2198.             PRINT "Working    / "
  2199.         CASE IS = 3             '   9
  2200.             CALL LocRowCol(15, 15)
  2201.             PRINT "Working    - "
  2202.         CASE IS = 4             ' 12
  2203.             CALL LocRowCol(15, 15)
  2204.             PRINT "Working    \ "
  2205.         CASE ELSE
  2206.           '  IF PrtRec% > 12 THEN PrtRec% = 1
  2207.             IF PrtRec% > 4 THEN PrtRec% = 1
  2208.         END SELECT
  2209.       
  2210.     END SUB
  2211.  
  2212.     SUB ReportTPLs (TPL%, Fhandle%)
  2213.         SELECT CASE TPL%
  2214.         CASE IS = 1
  2215.             IF HighAscii% THEN
  2216.               'Template # 1
  2217.                 PRINT #Fhandle%, "┌──────────────────┬────────────────────────────────────┬──────────────────┐"
  2218.                 PRINT #Fhandle%, "│░░░░░░░░░░░░░░░░░░│ Part I - Message Transfers & Calls │░░░░░░░░░░░░░░░░░░│"
  2219.                 PRINT #Fhandle%, "╞══════════════╤═══╧════════════════╤═══════════════════╧═════╤══════╤═════╡"
  2220.                 PRINT #Fhandle%, "│Zone:Net/Node │   Telephone Calls  │       Message Bytes     │  CPS │ Tran│"
  2221.                 PRINT #Fhandle%, "│    Number    │ Out │ Connect │ In │ Outgoing   │  Incoming  │  Avg │  Min│"
  2222.                 PRINT #Fhandle%, "╞══════════════╧═════╧═════════╧════╧════════════╧════════════╧══════╧═════╡"
  2223.             ELSE
  2224.                 PRINT #Fhandle%, "+------------------+------------------------------------+------------------+"
  2225.                 PRINT #Fhandle%, "|xxxxxxxxxxxxxxxxxx| Part I - Message Transfers & Calls |xxxxxxxxxxxxxxxxxx|"
  2226.                 PRINT #Fhandle%, "+==============+===+================+=========================+======+=====+"
  2227.                 PRINT #Fhandle%, "|Zone:Net/Node |   Telephone Calls  |       Message Bytes     |  CPS | Tran|"
  2228.                 PRINT #Fhandle%, "|    Number    | Out | Connect | In | Outgoing   |  Incoming  |  Avg |  Min|"
  2229.                 PRINT #Fhandle%, "+==============+=====+=========+====+============+============+======+====═+"
  2230.             END IF
  2231.         CASE IS = 2
  2232.             IF HighAscii% THEN
  2233.               'Template # 2
  2234.                 PRINT #Fhandle%, "╘══════════════════════════════════════════════════════════════════════════╛"
  2235.             ELSE
  2236.                 PRINT #Fhandle%, ">==========================================================================+"
  2237.             END IF
  2238.         CASE IS = 3
  2239.             IF HighAscii% THEN
  2240.               'Template # 3
  2241.                 PRINT #Fhandle%, "┌───────────────────┬──────────────────────────────────┬───────────────────┐"
  2242.                 PRINT #Fhandle%, "│░░░░░░░░░░░░░░░░░░░│ PART II - Network File Transfers │░░░░░░░░░░░░░░░░░░░│"
  2243.                 PRINT #Fhandle%, "╞══════════════╤════╧═══════════════╤══════════════════╧══════╤══════╤═════╡"
  2244.                 PRINT #Fhandle%, "│Zone:Net/Node │                    │       File Bytes        │  CPS │ Tran│"
  2245.                 PRINT #Fhandle%, "│    Number    │     File Names     │ Outgoing   │  Incoming  │ Rate │  Min│"
  2246.                 PRINT #Fhandle%, "╞══════════════╧════════════════════╧════════════╧════════════╧══════╧═════╡"
  2247.             ELSE
  2248.                 PRINT #Fhandle%, "+-------------------+----------------------------------+-------------------+"
  2249.                 PRINT #Fhandle%, "|xxxxxxxxxxxxxxxxxxx| PART II - Network File Transfers |xxxxxxxxxxxxxxxxxxx|"
  2250.                 PRINT #Fhandle%, "+==============+====+===============+==================+======+======+=====+"
  2251.                 PRINT #Fhandle%, "|Zone:Net/Node |                    |       File Bytes        |  CPS | Tran|"
  2252.                 PRINT #Fhandle%, "|    Number    |     File Names     | Outgoing   |  Incoming  | Rate |  Min|"
  2253.                 PRINT #Fhandle%, "+==============+====================+============+============+======+=====+"
  2254.             END IF
  2255.         CASE IS = 4
  2256.             IF HighAscii% THEN
  2257.               'Template # 4
  2258.                 PRINT #Fhandle%, "│                  No records to process for this report.                  │"
  2259.             ELSE
  2260.                 PRINT #Fhandle%, "|                  No records to process for this report.                  |"
  2261.             END IF
  2262.         CASE IS = 5
  2263.             IF HighAscii% THEN
  2264.               'Template # 5
  2265.                 PRINT #Fhandle%, "┌───────────────────┬──────────────────────────────────┬───────────────────┐"
  2266.                 PRINT #Fhandle%, "│░░░░░░░░░░░░░░░░░░░│ PART III - Network Session Costs │░░░░░░░░░░░░░░░░░░░│"
  2267.                 PRINT #Fhandle%, "╞══════════════╤════╧═══════════════╤══════════════════╧══════╤════════════╡"
  2268.                 PRINT #Fhandle%, "│Zone:Net/Node │     Logged At      │       Session Time      │    Cost    │"
  2269.                 PRINT #Fhandle%, "│    Number    │  Date   │   Time   │     Hrs │ Mins │ Secs   │            │"
  2270.                 PRINT #Fhandle%, "╞══════════════╧═════════╧══════════╧═════════╧══════╧════════╧════════════╡"
  2271.             ELSE
  2272.                 PRINT #Fhandle%, "+-------------------+----------------------------------+-------------------+"
  2273.                 PRINT #Fhandle%, "|xxxxxxxxxxxxxxxxxxx| PART III - Network Session Costs |xxxxxxxxxxxxxxxxxxx|"
  2274.                 PRINT #Fhandle%, "+==============+====+===============+==================+======+============+"
  2275.                 PRINT #Fhandle%, "|Zone:Net/Node |     Logged At      |       Session Time      |    Cost    |"
  2276.                 PRINT #Fhandle%, "|    Number    |  Date   |   Time   |     Hrs | Mins | Secs   |            |"
  2277.                 PRINT #Fhandle%, "+==============+=========+==========+=========+======+========+============+"
  2278.             END IF
  2279.         CASE IS = 6
  2280.             IF HighAscii% THEN
  2281.               'Template # 6
  2282.                 PRINT #Fhandle%, "│          No Network Session Costs recorded for the period covered.       │"
  2283.             ELSE
  2284.               
  2285.                 PRINT #Fhandle%, "|          No Network Session Costs recorded for the period covered.       |"
  2286.             END IF
  2287.         CASE IS = 7
  2288.             IF HighAscii% THEN
  2289.               'Template # 7
  2290.                 PRINT #Fhandle%, "┌───────────────────┬──────────────────────────────────┬───────────────────┐"
  2291.                 PRINT #Fhandle%, "│░░░░░░░░░░░░░░░░░░░│    PART IV - Undialable Nodes    │░░░░░░░░░░░░░░░░░░░│"
  2292.                 PRINT #Fhandle%, "╞═══════════════════╧══════════════════════════════════╧═══════════════════╡"
  2293.             ELSE
  2294.                 PRINT #Fhandle%, "+-------------------+----------------------------------+-------------------+"
  2295.                 PRINT #Fhandle%, "|xxxxxxxxxxxxxxxxxxx|    PART IV - Undialable Nodes    |xxxxxxxxxxxxxxxxxxx|"
  2296.                 PRINT #Fhandle%, "+===================+==================================+===================+"
  2297.             END IF
  2298.         CASE IS = 8
  2299.             IF HighAscii% THEN
  2300.               'Template # 8
  2301.                 PRINT #Fhandle%, "┌──────────────────────────┬────────────────────┬──────────────────────────┐"
  2302.                 PRINT #Fhandle%, "│░░░░░░░░░░░░░░░░░░░░░░░░░░│ PART  V - SUMMARY  │░░░░░░░░░░░░░░░░░░░░░░░░░░│"
  2303.                 PRINT #Fhandle%, "╞══════════════════════════╧════╤═══════════════╧══════════════════════════╡"
  2304.             ELSE
  2305.                 PRINT #Fhandle%, "+--------------------------+--------------------+--------------------------+"
  2306.                 PRINT #Fhandle%, "|xxxxxxxxxxxxxxxxxxxxxxxxxx| PART  V - SUMMARY  |xxxxxxxxxxxxxxxxxxxxxxxxxx|"
  2307.                 PRINT #Fhandle%, "+==========================+====================+==========================+"
  2308.             END IF
  2309.         CASE IS = 9
  2310.             IF HighAscii% THEN
  2311.               'Template # 9
  2312.                 PRINT #Fhandle%, "├──────────────────────────────────────────────────────────────────────────┤"
  2313.             ELSE
  2314.                 PRINT #Fhandle%, "+--------------------------------------------------------------------------+"
  2315.             END IF
  2316.         END SELECT
  2317.     END SUB
  2318.  
  2319.