REM Packutil utility v1.0a r2.0a for Dndbbs v5.0a r2.0a PD 01/10/2021:
REM  Prompts for date then displays activity in pack.log datafile.

REM Release r2.0a adds /! to write to packutil.out

REM compile:
REM  bc packutil/e/o;
REM  link packutil/e;

DIM SHARED Max.Row AS INTEGER

DECLARE SUB Read.Rows (Var%)
DECLARE SUB StatusLine ()
DECLARE FUNCTION ValidDate (V$)

REM Doesn't work in QB45 becuase of lack of FORMAT$ support..
REM   And QB45 has no ON LOCAL ERROR support..

REM Remove remarks from following lines for BC 7.1 IDE:
REM   Then start with QBX /L LIBRARY.QLB

REM Declare Function FormatD$(byval a#, b$)
REM Declare Function Now#()
REM Declare Function Format$(x#, x$)
REM Declare Function DateValue# (V$)
REM Function Format$(x#,x$) : Format$ = FormatD$(x#, x$) : End Function

ON ERROR GOTO ErrorRoutine

CONST Version$ = "v1.0a"
CONST Release$ = "r2.0a"

' display statusline at max.row
CALL StatusLine

' open input file
DND.Path$ = ENVIRON$("DNDBBS")
IF DND.Path$ <> "" THEN
   IF RIGHT$(DND.Path$, 1) <> "\" THEN
      DND.Path$ = DND.Path$ + "\"
   END IF
END IF
Filename$ = DND.Path$ + "pack.log"
IF DIR$(Filename$) = "" THEN
   COLOR 15
   PRINT "Packutil utility " + Version$ + " " + Release$
   PRINT
   COLOR 12
   PRINT "Pack.log not found. Run dndpack."
   GOTO EndLoop
END IF
' get date and switches from command line
c$ = COMMAND$: d$ = ""
IF LEN(c$) THEN
   IF c$ = "/?" OR c$ = "-?" THEN
      COLOR 15
      PRINT "Packutil utility " + Version$ + " " + Release$
      COLOR 14
      PRINT "Usage:"
      COLOR 15
      PRINT "  Packutil [date][/W][/X][/Y][/Z][/!]"
      COLOR 14
      PRINT "Where:"
      COLOR 15
      PRINT "  [date] is optional date in form MM-DD-YYYY"
      PRINT "  /W  dont display records/bytes packed."
      PRINT "  /X  displays only totals."
      PRINT "  /Y  dont display bank total."
      PRINT "  /Z  activate debug mode."
      Print "  /!  append to output file."
      GOTO EndLoop
   END IF
   d = INSTR(c$, "/W")
   IF d THEN
      dont2 = -1
      c$ = LEFT$(c$, d - 1) + MID$(c$, d + 2)
   END IF
   d = INSTR(c$, "/X")
   IF d THEN
      only = -1
      c$ = LEFT$(c$, d - 1) + MID$(c$, d + 2)
   END IF
   d = INSTR(c$, "/Y")
   IF d THEN
      dont = -1
      c$ = LEFT$(c$, d - 1) + MID$(c$, d + 2)
   END IF
   d = INSTR(c$, "/Z")
   IF d THEN
      debug = -1
      c$ = LEFT$(c$, d - 1) + MID$(c$, d + 2)
   END IF
   d = INSTR(c$, "/!")
   IF d THEN
      writefile = -1
      c$ = LEFT$(c$, d - 1) + MID$(c$, d + 2)
   END IF
   d$ = LTRIM$(RTRIM$(c$))
END IF
Filename2$ = DND.Path$ + "packutil.cfg"
IF DIR$(Filename2$) <> "" THEN
   OPEN Filename2$ FOR INPUT AS #2
   DO UNTIL EOF(2)
      LINE INPUT #2, p$: p$ = LTRIM$(LCASE$(p$))
      IF LEN(p$) THEN
         IF LEFT$(p$, 1) = ";" THEN
            Eat$ = ""
         ELSE
            V2 = INSTR(p$, "=")
            IF V2 THEN
               p1$ = LEFT$(p$, V2 - 1)
               p2$ = MID$(p$, V2 + 1)
               p1$ = LTRIM$(RTRIM$(p1$))
               p2$ = LTRIM$(RTRIM$(p2$))
               SELECT CASE p1$
               CASE "only"
                  SELECT CASE p2$
                  CASE "-1", "on", "true"
                     only = -1
                  CASE "0", "off", "false"
                     only = 0
                  END SELECT
               CASE "dont"
                  SELECT CASE p2$
                  CASE "-1", "on", "true"
                     dont = -1
                  CASE "0", "off", "false"
                     dont = 0
                  END SELECT
               CASE "dont2"
                  SELECT CASE p2$
                  CASE "-1", "on", "true"
                     dont2 = -1
                  CASE "0", "off", "false"
                     dont2 = 0
                  END SELECT
               CASE "debug"
                  SELECT CASE p2$
                  CASE "-1", "on", "true"
                     debug = -1
                  CASE "0", "off", "false"
                     debug = 0
                  END SELECT
               CASE "write"
                  SELECT CASE p2$
                  CASE "-1", "on", "true"
                     writefile = -1
                  CASE "0", "off", "false"
                     writefile = 0
                  END SELECT
               CASE "date"
                  d$ = p2$
               END SELECT
            END IF
         END IF
      END IF
   LOOP
END IF
' open report file
If writefile then
   Filename3$ = DND.Path$ + "packutil.out"
   OPEN Filename3$ FOR APPEND AS #3
Endif
COLOR 15
PRINT "Packutil utility " + Version$ + " " + Release$
IF d$ = "ALL" THEN
   d$ = ""
ELSE
   IF d$ = "" THEN
      PRINT "Date(MM-DD-YYYY)<enter=all>";
      INPUT d$
   END IF
END IF
IF LEN(d$) THEN
   IF ValidDate(d$) = 0 THEN
      COLOR 12
      PRINT
      PRINT "Invalid date. Edit command line or packutil.cfg."
      writefile = 0
      GOTO EndLoop
   END IF
END IF
' init report file
If writefile Then
   Print #3, "Packutil utility " + Version$ + " " + Release$ + " report for " + Format$(Now, "mm-dd-yyyy") + " " + Format$(Now, "hh:mm:ss")
Endif
' start search loop.
OPEN Filename$ FOR INPUT AS #1
COLOR 14
PRINT "Searching: ";
IF d$ = "" THEN PRINT "<all>" ELSE PRINT d$
COLOR 15
DO WHILE EOF(1) = 0
100
   LINE INPUT #1, x$
   ' input string is case-sensitive
   Z5# = Z5# + 1#
   Z6# = Z6# + Len(x$) + 2#
   ' compare pack started
   IF d$ <> "" THEN
      REM Pack log started 02-28-2019 23:30:24.
      IF LEFT$(x$, 16) = "Pack log started" THEN
         x$ = MID$(x$, 18): x$ = LEFT$(x$, 10)' date
         IF d$ = x$ THEN
            GOSUB Parse.Pack
         END IF
      END IF
   ELSE ' <all>
      GOSUB Parse.Pack
   END IF
LOOP
IF V1# = 1# THEN
   Var3$ = "Total: " + Format$(V1#, "#,##0;;") + " node reset."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
ELSE
   Var3$ = "Total: " + Format$(V1#, "#,##0;;") + " nodes reset."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
END IF
IF V2# = 1# THEN
   Var3$ = "Total: " + Format$(V2#, "#,##0;;") + " node deleted."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
ELSE
   Var3$ = "Total: " + Format$(V2#, "#,##0;;") + " nodes deleted."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
END IF
IF V3# = 1# THEN
   Var3$ = "Total: " + Format$(V3#, "#,##0;;") + " node repaired."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
ELSE
   Var3$ = "Total: " + Format$(V3#, "#,##0;;") + " nodes repaired."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
END IF
IF only THEN GOTO EndLoop
COLOR 10
IF dont2 THEN GOTO PackLoop
Var3$ = "Records packed: " + Format$(Z1#, "#,##0;;")
Print Var3$
If writefile Then
   Print #3,Var3$
Endif
Var3$ = "Bytes packed: " + Format$(Z2#, "#,##0;;")
Print Var3$
If writefile Then
   Print #3,Var3$
Endif
PackLoop:
IF dont THEN GOTO NextLoop
IF Z3# = 1# THEN
   Var3$ = "Bank file packed: " + Format$(Z3#, "#,##0;;") + " time."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
ELSE
   Var3$ = "Bank file packed: " + Format$(Z3#, "#,##0;;") + " times."
   Print Var3$
   If writefile Then
      Print #3,Var3$
   Endif
END IF
NextLoop:
IF debug=0 THEN Goto EndLoop
COLOR 12
Z4# = 1#
Var3$ = "Files counted: " + Format$(Z4#, "#,##0;;")
Print Var3$;
If writefile Then
   Print #3,Var3$;
Endif
Color 15
Call Make.Format(Var$, Z4#)
Print " (";Var$;")"
If writefile Then
   Print #3, " (";Var$;")"
Endif
COLOR 12
Var3$ ="Lines counted: " + Format$(Z5#, "#,##0;;")
Print Var3$;
If writefile Then
   Print #3,Var3$;
Endif
Color 15
Call Make.Format(Var$, Z5#)
Print " (";Var$;")"
If writefile Then
   Print #3, " (";Var$;")"
Endif
COLOR 12
Var3$ = "Bytes counted: " + Format$(Z6#, "#,##0;;")
Print Var3$;
If writefile Then
   Print #3,Var3$;
Endif
Color 15
Call Make.Format(Var$, Z6#)
Print " (";Var$;")"
If writefile Then
   Print #3, " (";Var$;")"
Endif
EndLoop:
COLOR 7, 0
LOCATE Max.Row, 1, 1
PRINT SPACE$(80);
If writefile Then
   PRINT "Now exiting Packutil. Output appended to packutil.out file."
Else
   PRINT "Now exiting Packutil."
Endif
END

' search until not date
Parse.Pack:
150
 DO UNTIL EOF(1)
    LINE INPUT #1, z$
    Z5# = Z5# + 1#
    Z6# = Z6# + Len(z$) + 2#
    ' input string is case-sensitive
    IF d$ <> "" THEN
       IF LEFT$(z$, 16) = "Pack log started" THEN
          q$ = MID$(z$, 18): q$ = LEFT$(q$, 10)' date
          IF d$ <> q$ THEN
             EXIT DO
          END IF
       END IF
    END IF
200
    IF INSTR(z$, "Reset") THEN
       q$ = LTRIM$(MID$(z$, INSTR(z$, "Reset") + 5))' reset
       q = INSTR(q$, "nodes")
       IF q THEN q$ = LEFT$(q$, q - 1): V1# = V1# + VAL(q$)
    END IF
300
    IF INSTR(z$, "Deleted") THEN
       q$ = LTRIM$(MID$(z$, INSTR(z$, "Deleted") + 7))' deleted
       q = INSTR(q$, "nodes")
       IF q THEN q$ = LEFT$(q$, q - 1): V2# = V2# + VAL(q$)
    END IF
400
    IF INSTR(z$, "Repaired") THEN
       q$ = LTRIM$(MID$(z$, INSTR(z$, "Repaired") + 8))' repaired
       q = INSTR(q$, "nodes")
       IF q THEN q$ = LEFT$(q$, q - 1): V3# = V3# + VAL(q$)
    END IF
500
    IF LEFT$(z$, 17) = "--Records packed:" THEN
       q$ = MID$(z$, 19)
       DO
          IF INSTR(q$, ",") THEN
             q$ = LEFT$(q$, INSTR(q$, ",") - 1) + MID$(q$, INSTR(q$, ",") + 1)
          ELSE
             EXIT DO
          END IF
       LOOP
       Z1# = Z1# + VAL(q$)
    END IF
600
    IF LEFT$(z$, 15) = "--Bytes packed:" THEN
       q$ = MID$(z$, 17)
       DO
          IF INSTR(q$, ",") THEN
             q$ = LEFT$(q$, INSTR(q$, ",") - 1) + MID$(q$, INSTR(q$, ",") + 1)
          ELSE
             EXIT DO
          END IF
       LOOP
       Z2# = Z2# + VAL(q$)
    END IF
700
   IF LEFT$(z$, 17) = "Bank file packed." THEN
      Z3# = Z3# + 1#
   END IF
 LOOP
 RETURN

ErrorRoutine:
 COLOR 12
 PRINT "Error"; ERR; "line"; ERL
 RESUME EndLoop
 END

SUB Read.Rows (Var%)
 ON LOCAL ERROR GOTO Error.Trap62x
 Temp1 = 50
 LOCATE 50, 1, 0
 Var% = 50
 EXIT SUB
Next.Trap1:
 Temp1 = 43
 LOCATE 43, 1, 0
 Var% = 43
 EXIT SUB
Next.Trap2:
 Temp1 = 25
 LOCATE 25, 1, 0
 Var% = 25
 EXIT SUB
Next.Trap3:
 Var% = 12
Error.Resume62x:
 EXIT SUB
Error.Trap62x:
 IF Temp1 = 50 THEN
    RESUME Next.Trap1
 END IF
 IF Temp1 = 43 THEN
    RESUME Next.Trap2
 END IF
 IF Temp1 = 25 THEN
    RESUME Next.Trap3
 END IF
 RESUME Error.Resume62x
END SUB

' display statusline
' init max.row
SUB StatusLine
CALL Read.Rows(Max.Row)
LOCATE Max.Row, 1, 1
COLOR 15, 1
S$ = "Packutil utility " + Version$ + " " + Release$ + " " + Format$(Now, "mm-dd-yyyy") + " " + Format$(Now, "hh:mm:ss")
S$ = LEFT$(S$, 80)
S$ = S$ + SPACE$(80 - LEN(S$))
PRINT S$;
LOCATE Max.Row - 1, 1, 1
COLOR 15, 0
END SUB

FUNCTION ValidDate (Var$)
 ON LOCAL ERROR GOTO DateError
 ValidDate = -1 ' defaults to valid
 IF LEN(Var$) <> 10 THEN
    GOTO DateResume
 END IF
 FOR Var = 1 TO 10 ' mm-dd-yyyy
    V$ = MID$(Var$, Var, 1)
    SELECT CASE Var
    CASE 1, 2, 4, 5, 7, 8, 9, 10
       IF V$ >= "0" AND V$ <= "9" THEN
          Eat$ = ""
       ELSE
          GOTO DateResume
       END IF
    CASE ELSE
       IF V$ = "/" THEN ' override switch
          MID$(Var$, Var, 1) = "-" : V$ = "-"
       END IF
       IF V$ <> "-" THEN
          GOTO DateResume
       END IF
    END SELECT
 NEXT
 Temp# = DateValue(Var$)
 IF Temp# = 0# THEN
    ValidDate = 0
 END IF
 EXIT FUNCTION
DateResume:
 ValidDate = 0
 EXIT FUNCTION
DateError:
 RESUME DateResume
END FUNCTION

Sub Make.Format(Var$, Var#)
 On Local Error Goto ErrTrap13
 Var2#=Var#
 If Var2#<=0 Then
    Var$="0.00 B"
    Exit Sub
 Endif
 TempA=False
 Do
    If Var2#<1024# Then
       Exit Do
    Endif
    Var2#=Var2#/1024#
    TempA=TempA+1
    If TempA=8 Then
       Exit Do
    Endif
 Loop
 Var$=""
 If TempA>=1 And TempA<=8 Then
    Var$=Mid$("KMGTPEZY",TempA,1)
 Endif
 Var$=Format$(Var2#,"#,##0.00;;")+" "+Var$+"B"
ErrResume13:
 Exit Sub
ErrTrap13:
 Resume ErrResume13
End Sub
