REM Created utility v1.0a for Dndbbs v5.0a r2.0a PD 03/10/2020:
REM  Prompts for codename and date then displays activity in datafile.

REM compile:
REM  bc created/e/o;
REM  link created/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$ = "r1.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$ + "created.dat"
IF DIR$(Filename$) = "" THEN
   COLOR 15
   PRINT "Created.dat not found."
   OPEN Filename$ FOR OUTPUT AS #1
   PRINT #1, ";created.dat file for DM usage"
   CLOSE
   PRINT "File initialized."
   GOTO EndLoop
END IF
OPEN Filename$ FOR INPUT AS #1

' get username/date from command line
c$ = COMMAND$: u$ = "": d$ = ""
IF LEN(c$) THEN
   IF c$ = "/?" OR c$ = "-?" THEN
      COLOR 15
      PRINT "Created utility " + Version$ + " " + Release$
      COLOR 14
      PRINT "Usage:"
      COLOR 15
      PRINT "  Created [username] [date]"
      COLOR 14
      PRINT "Where:"
      COLOR 15
      PRINT "  [username] is optional username"
      PRINT "  [date] is optional date in form MM-DD-YYYY"
      GOTO EndLoop
   END IF
   d = INSTR(c$, "/Z")
   IF d THEN
      Debug = -1
      c$ = LEFT$(c$, d - 1) + MID$(c$, d + 2)
   END IF
   c$ = LTRIM$(RTRIM$(c$))
   IF INSTR(c$, " ") THEN
      u$ = LCASE$(LEFT$(c$, INSTR(c$, " ") - 1))
      d$ = MID$(c$, INSTR(c$, " ") + 1)
      d$ = LTRIM$(d$)
      IF Debug THEN
         PRINT d$
      END IF
   ELSE
      u$ = LCASE$(c$)
   END IF
   IF LEFT$(u$, 1) = CHR$(34) THEN
      IF RIGHT$(u$, 1) = CHR$(34) THEN
         u$ = LEFT$(u$, LEN(u$) - 1)
         u$ = MID$(u$, 2)
      END IF
   END IF
   COLOR 15
   PRINT "Created utility "; Version$; " "; Release$
   GOTO StartLoop
END IF
COLOR 15
PRINT "Created utility "; Version$; " "; Release$
COLOR 15
PRINT "Username";
INPUT u$
PRINT "Date(MM-DD-YYYY)";
INPUT d$

StartLoop:
IF LEN(u$) THEN
   u$ = LCASE$(u$) + " "
END IF
IF LEN(d$) THEN
   IF ValidDate(d$) = 0 THEN
      PRINT "Invalid date."
      GOTO EndLoop
   END IF
END IF
COLOR 14
PRINT "Searching: ";
IF u$ = "" THEN PRINT "<all>" ELSE PRINT u$

REM Read lines from datafile in form:
REM <codename> edited room <##> on <date> <time>

COLOR 15
DO WHILE EOF(1) = 0
100
   ' compare username
   LINE INPUT #1, x$
   x$ = LCASE$(x$)
   x$ = LTRIM$(x$)
   x = 0
   IF LEFT$(x$, 1) = ";" THEN ' ignore comment
      Eat$ = ""
   ELSE
      IF u$ = "" THEN
         x = -1
      ELSE
         IF LEFT$(x$, LEN(u$)) = u$ THEN
            x = -1
         END IF
      END IF
   END IF
101
   IF x THEN
      x$ = LEFT$(x$, LEN(x$) - 8) ' strip time
      x$ = RTRIM$(x$)
      z$ = RIGHT$(x$, 10) ' get date
102
      ' compare date
      z = 0
      IF d$ = "" THEN
         z = -1
      ELSE
         IF z$ = d$ THEN
            z = -1
         END IF
      END IF
103
      IF z THEN
         IF Debug THEN
            COLOR 12
            PRINT x$
            COLOR 15
         END IF
         x$ = MID$(x$, INSTR(x$, " ") + 1)
         x$ = LTRIM$(x$)
         IF LEFT$(x$, 6) = "edited" THEN z1! = z1! + 1!
         IF LEFT$(x$, 7) = "created" THEN z2! = z2! + 1!
      END IF
   END IF
LOOP
104
IF LEN(u$) THEN
   MID$(u$, 1, 1) = UCASE$(MID$(u$, 1, 1))
END IF
IF LEN(u$) THEN
   PRINT u$; "edited"; z1!;
   IF z1! = 1! THEN PRINT "room ";  ELSE PRINT "rooms ";
   IF d$ = "" THEN PRINT "(total)" ELSE PRINT "on "; d$
ELSE
   PRINT "Total edited"; z1!;
   IF z1! = 1! THEN PRINT "room." ELSE PRINT "rooms."
END IF

IF LEN(u$) THEN
   PRINT u$; "created"; z2!;
   IF z2! = 1! THEN PRINT "room ";  ELSE PRINT "rooms ";
   IF d$ = "" THEN PRINT "(total)" ELSE PRINT "on "; d$
ELSE
   PRINT "Total created"; z2!;
   IF z2! = 1! THEN PRINT "room." ELSE PRINT "rooms."
END IF

EndLoop:
COLOR 7, 0
LOCATE Max.Row, 1, 1
PRINT SPACE$(80);
PRINT "Now exiting Created."
END

ErrorRoutine:
 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$ = "Created 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
          GOTO DateResume
       END IF
    END SELECT
 NEXT
 Temp#=DateValue(Var$)
 If Temp# = 0# Then
    ValidDate = 0
 Endif
 EXIT FUNCTION
DateResume:
 ValidDate = 0
 EXIT FUNCTION
DateError:
 RESUME DateResume
END FUNCTION
