' List the RBBS User file several ways
'  Copyright 1990 - Allen P. Dew
'
1000 KEY OFF: CLS
     ON ERROR GOTO 9900
     Way$ = ""
     Num& = 0
     DRV$ = "D:"
     CNAM$ = "MAINU.DEF"
     INPUT "USERS file is on drive:path [D:]"; XDRV$
     INPUT "Name of USERS file: [Mainu.def] "; XCNAM$
     IF XDRV$ <> "" THEN DRV$ = XDRV$
     IF XCNAM$ <> "" THEN CNAM$ = XCNAM$
     FINAM$ = DRV$ + CNAM$
     OPEN FINAM$ FOR INPUT AS #1
     CLOSE #1
     GOSUB 9400
     PRINT "Please wait while work file is built"
1050 OPEN "USERWKX" FOR OUTPUT AS #2
     CLOSE #2
     KILL "USERWKX"
     OPEN "USERWKX" FOR RANDOM AS #2 LEN=128
     FIELD #2, 128 AS NN$
     Num& = 0
     FOR I& = 1 TO LAST&
	        GOSUB 8300
         IF ASC(ZUserName$) > 32 AND LEFT$(ZUserName$,7) <> "NEWUSER" THEN
             W% = INSTR(ZUserName$," ")
             ZFirst$ = LEFT$(ZUserName$,W%-1)
             ZLast$ = MID$(ZUserName$,W%+1,31-W%)
             ZLast$ = RTRIM$(ZLast$) + ", "
             W% = LEN(ZLast$)
             LSET ZUserName$ = ZLast$
             MID$(ZUserName$,W%+1,31-W%) = ZFirst$
    	        LSET NN$ = N$
             Num& = Num& + 1
	            PUT #2,Num&
         END IF
     NEXT I&
     CLOSE

1100 CLS
     CNT = 0
     LOCATE 2, 18
     PRINT "==  List the RBBS Users File  ==               V1.4"
     PRINT TAB(20); Num&; " users found in "; CNAM$
     PRINT
     PRINT TAB(20); "A - List by name"
     PRINT TAB(20); "B - List by city-state"
     PRINT TAB(20); "C - List by last time on"
     PRINT
     PRINT TAB(20); "W - Open a different User file"
     PRINT TAB(20); "X - Exit this program"
     LOCATE 24, 8
     PRINT "Copyright 1990 Allen Dew       Geneal Board         919-471-6026";
1200 LOCATE 16, 1
     PRINT TAB(20); "Enter letter to do ==>          "
     LOCATE 16, 43
     INPUT "", ACT$
     ACT$ = UCASE$(LEFT$(ACT$, 1))
     IF ACT$ = "X" THEN GOTO 9000
     IF ACT$ = "W" THEN
         CLOSE
         GOTO 1000
     END IF
     IF ACT$ < "A" OR ACT$ > "C" THEN
	        BEEP
	        GOTO 1200
     END IF
     IF ACT$ = "A" THEN GOSUB 3000
     IF ACT$ = "B" THEN GOSUB 3100
     IF ACT$ = "C" THEN GOSUB 3200
     GOTO 1100

3000 '        LIST BY NAME
     CLOSE
     IF Way$ = "N" THEN GOTO 3020
     PRINT "Sorting by name....."
     SHELL "SORTF USERWKX USERWKY /L128 /+1,31 /C /Q"
3020 '
     FINAM$ = "USERWKY"
     Way$ = "N"
     GOSUB 9400
     GOSUB 7000
     RETURN

3100 '        LIST BY CITY
     CLOSE
     IF Way$ = "C" THEN GOTO 3120
     PRINT "Sorting by city....."
     SHELL "SORTF USERWKX USERWKY /L128 /+63,24 /+1,31 /C /Q"
3120 '
     FINAM$ = "USERWKY"
     Way$ = "C"
     GOSUB 9400
     GOSUB 7000
     RETURN

3200 '        LIST BY LAST TIME ON
     CLOSE
     IF Way$ = "D" THEN GOTO 3220
     PRINT "Sorting by last time on....."
     SHELL "SORTF USERWKX USERWKY /L128 /-112,2 /-106,14 /+1,31 /C /Q"
3220 '
     FINAM$ = "USERWKY"
     Way$ = "D"
     GOSUB 9400
     GOSUB 7000
     RETURN

7000 '        SHOW LINES ON DISPLAY
     FOR I& = 1 TO LAST&
	        GOSUB 8300
	        L$ = ZUserName$ + "  " + ZCityState$ + " " + ZLastDateTimeOn$
         GOSUB 8000
     NEXT I&
     GOSUB 8200
     RETURN

7500 '        LIST VARIABLE SEARCH DATA
     FOR I& = LAST& TO 1 STEP -1
	        GOSUB 8300
	        W% = INSTR(N$, ONAT$)
	        X% = INSTR(N$, LNT$)
	        IF W% <> 0 THEN W$ = N$: M% = 1
	        IF X% <> 0 THEN X$ = N$
	        K% = INSTR(N$, VARB$)
	        IF K% <> 0 AND M% <> 0 THEN
	           	L$ = W$
		           GOSUB 8000
		           L$ = X$
		           GOSUB 8000
		           M% = 0
	        END IF
	        IF K% <> 0 THEN
		           L$ = N$
		           GOSUB 8000
	        END IF
     NEXT I&
     GOSUB 8200
     RETURN
8000 '
     PRINT L$
     CNT = CNT + 1
     IF CNT < 23 THEN RETURN
     CNT = 0
     INPUT "--more--[y]/n"; CNT$
     CNT$ = UCASE$(LEFT$(CNT$, 1))
     IF CNT$ = "N" THEN I& = LAST& +1
     RETURN
8200 '
     PRINT ""
     INPUT "That's all. Enter to continue.", CNT$
     RETURN
8300 '
     GET #1, I&
     TEST$ = INKEY$
     IF LEN(TEST$) = 0 THEN RETURN
     IF ASC(TEST$) = 27 THEN I& = 1
     GOSUB 9500
     RETURN
8400 '
     LOCATE 17, 10
     PRINT "Use the ESC key to halt search."
     LOCATE 18, 10
     PRINT LYN$;
     INPUT CALR$
     PRINT
     RETURN
9000 '
     CLOSE
     CLS
     SYSTEM

9400 '
     OPEN "R", #1, FINAM$, 128
     LAST& = LOF(1) / 128

     FIELD #1, 128 AS N$
     FIELD #1, 31 AS ZUserName$, _
               15 AS ZPswd$, _
                2 AS ZSecLevel$, _
               14 AS ZUserOption$,  _
               24 AS ZCityState$, _
                3 AS ZMachineType$, _
                4 AS ZTodayDl$, _
                4 AS ZTodayBytes$, _
                4 AS ZDlBytes$, _
                4 AS ZULBytes$, _
               14 AS ZLastDateTimeOn$, _
                3 AS ZListNewDate$, _
                2 AS ZUserDnlds$, _
                2 AS ZUserUplds$, _
                2 AS ZElapsedTime$
     RETURN

9500 '        EXPLODE THE USER DATA
     ZUserSecLevel = CVI(ZSecLevel$)
     ZLastMsgRead = CVI(MID$(ZUserOption$,3,2))
     ZUserXferDefault$ = MID$(ZUserOption$,5,1)
     IF ZUserXferDefault$ = " " THEN
        ZUserXferDefault$ = "N"
     END IF
     WasX = ASC(MID$(ZUserOption$,6,1))
     ZWasGR = (WasX MOD 3)
     ZBoldText$ = CHR$(48 - (WasX > 50))
     ZUserTextColor = (WasX - ZWasGR)/3 + 21
     IF ZUserTextColor > 37 THEN
        ZUserTextColor = ZUserTextColor - 7
     END IF
     ZRightMargin = CVI(MID$(ZUserOption$,7,2))
     IF ZRightMargin > 72 THEN
        ZRightMargin = 72
     END IF
     XCityState$ = LTRIM$(RTRIM$(ZCityState$))
     UserOptions = CVI(MID$(ZUserOption$,9,2))
     ZPromptBell = (UserOptions AND 1) > 0
     ZExpertUser = (UserOptions AND 2) > 0
     ZNulls = (UserOptions AND 4) > 0
     ZUpperCase = (UserOptions AND 8) > 0
     ZLineFeeds = (UserOptions AND 16) > 0
     ZCheckBulletLogon = (UserOptions AND 32) > 0
     ZSkipFilesLogon = (UserOptions AND 64) > 0
     ZAutoDownDesired = (UserOptions AND 128) > 0
     ZReqQuesAnswered = (UserOptions AND 256) > 0
     ZMailWaiting = (UserOptions AND 512) > 0
     ZHilite = (UserOptions AND 1024 ) > 0
     ZTurboKeyUser = (UserOptions AND 2048) > 0
     ZPageLength = ASC(MID$(ZUserOption$,13,1))
     ZEchoer$ = MID$(ZUserOption$,14,1)
     IF INSTR("ICR",ZEchoer$) = 0 THEN
        ZEchoer$ = "R"
     END IF
     RETURN

9900 '
     IF ERR <> 53 THEN               ' FILE NOT FOUND
         PRINT "Error  "; ERR; "   at line  "; ERL
         END
     END IF
     IF ERL = 1050 THEN RESUME NEXT
     PRINT ""
     INPUT "Callers file not found. Retry ? Y/N ", CNT$
     CNT$ = UCASE$(LEFT$(CNT$, 1))
     IF CNT$ = "Y" AND LEFT$(FINAM$,6) <> "USERWK" THEN RESUME 1000
     IF CNT$ = "N" THEN RESUME 9000
     GOTO 9900