home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / LSTCAL15.ZIP / LISTCALL.BAS next >
Encoding:
BASIC Source File  |  1990-10-26  |  7.7 KB  |  344 lines
  1. ' List the RBBS Callers file several ways       Ver. 1.5
  2. '  Copyright 1989,1990 - Allen P. Dew
  3. '
  4. 1000 KEY OFF: CLS
  5.      ON ERROR GOTO 9900
  6.      ONAT$ = "on at"
  7.      LNT$ = "} "
  8.      UPLD$ = ">> uploaded"
  9.      DNLD$ = "Downloaded"
  10.      KILD$ = "Killed Msg"
  11.      DRV$ = "D:"
  12.      CNAM$ = "CALLERS"
  13.      INPUT "CALLERS file is on drive:path [D:]"; XDRV$
  14.      INPUT "Name of [CALLERS] file: "; XCNAM$
  15.      IF XDRV$ <> "" THEN DRV$ = XDRV$
  16.      IF XCNAM$ <> "" THEN CNAM$ = XCNAM$
  17.      FINAM$ = DRV$ + CNAM$
  18.      OPEN FINAM$ FOR INPUT AS #1
  19.      CLOSE #1
  20.      OPEN "R", #1, FINAM$, 64
  21.      FIELD #1, 64 AS N$
  22.      LAST& = LOF(1) / 64
  23. 1100 CLS
  24.      CNT = 0
  25.      LOCATE 1, 8
  26.      PRINT "Copyright 1990 Allen Dew       Geneal Board         919-471-6026";
  27.      LOCATE 2, 18
  28.      PRINT "==  List the RBBS Callers File  ==               V1.5"
  29.      PRINT
  30.      PRINT TAB(20); "A - List all"
  31.      PRINT TAB(20); "B - List all uploads"
  32.      PRINT TAB(20); "C - List all downloads"
  33.      PRINT TAB(20); "D - List a callers uploads"
  34.      PRINT TAB(20); "E - List a callers downloads"
  35.      PRINT TAB(20); "F - List a file uploaded"
  36.      PRINT TAB(20); "G - List a file downloaded"
  37.      PRINT TAB(20); "H - List callers date,time,length,baud"
  38.      PRINT TAB(20); "I - List a callers logins"
  39.      PRINT TAB(20); "J - List killed messages"
  40.      PRINT TAB(20); "K - Search for any string"
  41.      PRINT TAB(20); "W - Open a different Caller file"
  42.      PRINT TAB(20); "X - Exit this program"
  43. 1200 LOCATE 18, 1
  44.      PRINT TAB(20); "Enter letter to do ==>          "
  45.      LOCATE 18, 43
  46.      INPUT "", Act$
  47.      Act$ = UCASE$(LEFT$(Act$, 1))
  48.      SELECT CASE Act$
  49.     CASE IS = "X"
  50.        GOTO 9000
  51.     CASE IS = "W"
  52.        CLOSE
  53.        GOTO 1000
  54.     CASE IS = "A"
  55.        GOSUB 3000
  56.     CASE IS = "B"
  57.        GOSUB 3200
  58.     CASE IS = "C"
  59.        GOSUB 3400
  60.     CASE IS = "D"
  61.        GOSUB 3600
  62.     CASE IS = "E"
  63.        GOSUB 3800
  64.     CASE IS = "F"
  65.        GOSUB 4000
  66.     CASE IS = "G"
  67.        GOSUB 4200
  68.     CASE IS = "H"
  69.        GOSUB 4400
  70.     CASE IS = "I"
  71.        GOSUB 4600
  72.     CASE IS = "J"
  73.        GOSUB 4800
  74.     CASE IS = "K"
  75.        GOSUB 5000
  76.     CASE ELSE
  77.        BEEP
  78.        GOTO 1200
  79.      END SELECT
  80.      GOTO 1100
  81. 3000 '        LIST ALL
  82.      FOR I& = LAST& TO 1 STEP -1
  83.      GOSUB 8300
  84.      L$ = N$
  85.      GOSUB 8000
  86.      NEXT I&
  87.      GOSUB 8200
  88.      RETURN
  89. 3200 '        LIST ALL UPLOAD
  90.      Varb$ = UPLD$
  91.      GOSUB 7500
  92.      RETURN
  93. 3400 '        LIST ALL DOWNLOAD
  94.      Varb$ = DNLD$
  95.      GOSUB 7500
  96.      RETURN
  97. 3600 '        LIST A CALLERS UPLOADS
  98.      Lyn$ = "Name of caller to search for "
  99.      GOSUB 8400
  100.      IF LEN(CALR$) < 1 THEN 3600
  101.      CALR$ = UCASE$(CALR$)
  102.      FOR I& = LAST& TO 1 STEP -1
  103.      GOSUB 8300
  104.      W% = INSTR(N$, ONAT$)
  105.      X% = INSTR(N$, LNT$)
  106.      IF W% <> 0 THEN
  107.          W$ = N$
  108.          M% = 1
  109.      END IF
  110.      IF M% = 1 THEN L% = INSTR(W$, CALR$)
  111.      IF X% <> 0 THEN X$ = N$
  112.      K% = INSTR(N$, UPLD$)
  113.      IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
  114.          L$ = W$
  115.          GOSUB 8000
  116.          L$ = X$
  117.          GOSUB 8000
  118.          M% = 0
  119.      END IF
  120.      IF K% <> 0 AND L% <> 0 THEN
  121.          L$ = N$
  122.          GOSUB 8000
  123.      END IF
  124.      NEXT I&
  125.      GOSUB 8200
  126.      RETURN
  127. 3800 '        LIST A CALLERS DOWNLOADS
  128.      Lyn$ = "Name of caller to search for "
  129.      GOSUB 8400
  130.      IF LEN(CALR$) < 1 THEN 3800
  131.      CALR$ = UCASE$(CALR$)
  132.      FOR I& = LAST& TO 1 STEP -1
  133.      GOSUB 8300
  134.      W% = INSTR(N$, ONAT$)
  135.      X% = INSTR(N$, LNT$)
  136.      IF W% <> 0 THEN
  137.          W$ = N$
  138.          M% = 1
  139.      END IF
  140.      IF M% = 1 THEN L% = INSTR(W$, CALR$)
  141.      IF X% <> 0 THEN X$ = N$
  142.      K% = INSTR(N$, DNLD$)
  143.      IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
  144.          L$ = W$
  145.          GOSUB 8000
  146.          L$ = X$
  147.          GOSUB 8000
  148.          M% = 0
  149.      END IF
  150.      IF K% <> 0 AND L% <> 0 THEN
  151.          L$ = N$
  152.          GOSUB 8000
  153.      END IF
  154.      NEXT I&
  155.      GOSUB 8200
  156.      RETURN
  157. 4000 '        LIST FILE UPLOADED
  158.      Lyn$ = "Name of file to search for "
  159.      GOSUB 8400
  160.      IF LEN(CALR$) < 1 THEN 4800
  161.      CALR$ = UCASE$(CALR$)
  162.      FOR I& = LAST& TO 1 STEP -1
  163.      GOSUB 8300
  164.      W% = INSTR(N$, ONAT$)
  165.      X% = INSTR(N$, LNT$)
  166.      IF W% <> 0 THEN
  167.          W$ = N$
  168.          M% = 1
  169.      END IF
  170.      IF X% <> 0 THEN X$ = N$
  171.      K% = INSTR(N$, UPLD$)
  172.      IF K% <> 0 THEN L% = INSTR(N$, CALR$)
  173.      IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
  174.          L$ = W$
  175.          GOSUB 8000
  176.          L$ = X$
  177.          GOSUB 8000
  178.          M% = 0
  179.      END IF
  180.      IF K% <> 0 AND L% <> 0 THEN
  181.          L$ = N$
  182.          GOSUB 8000
  183.      END IF
  184.      NEXT I&
  185.      GOSUB 8200
  186.      RETURN
  187. 4200 '        LIST FILE DOWNLOADED
  188.      Lyn$ = "Name of file to search for "
  189.      GOSUB 8400
  190.      IF LEN(CALR$) < 1 THEN 4200
  191.      CALR$ = UCASE$(CALR$)
  192.      FOR I& = LAST& TO 1 STEP -1
  193.      GOSUB 8300
  194.      W% = INSTR(N$, ONAT$)
  195.      X% = INSTR(N$, LNT$)
  196.      IF W% <> 0 THEN
  197.          W$ = N$
  198.          M% = 1
  199.      END IF
  200.      IF X% <> 0 THEN X$ = N$
  201.      K% = INSTR(N$, DNLD$)
  202.      IF K% <> 0 THEN L% = INSTR(N$, CALR$)
  203.      IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
  204.          L$ = W$
  205.          GOSUB 8000
  206.          L$ = X$
  207.          GOSUB 8000
  208.          M% = 0
  209.      END IF
  210.      IF K% <> 0 AND L% <> 0 THEN
  211.          L$ = N$
  212.          GOSUB 8000
  213.      END IF
  214.      NEXT I&
  215.      GOSUB 8200
  216.      RETURN
  217. 4400 '        LIST CALLERS DATE,TIME,LENGTH,BAUD
  218.     FOR I& = LAST& TO 1 STEP -1
  219.     GOSUB 8300
  220.     K% = INSTR(N$, ONAT$)
  221.     IF K% <> 0 THEN
  222.         P$ = N$
  223.         I& = I& - 1
  224.         GOSUB 8300
  225.         Q$ = P$ + N$
  226.         L% = INSTR(Q$, ONAT$) - 2
  227.         NAM$ = LEFT$(Q$, L%)
  228.         NAM$ = NAM$ + SPACE$(30)
  229.         NAM$ = LEFT$(NAM$, 30)
  230.         TOS$ = MID$(Q$, 119, 9)
  231.         DAT$ = MID$(Q$, L% + 8, 8)
  232.         TIM$ = MID$(Q$, L% + 18, 8)
  233.         R% = INSTR(Q$, " BAUD")
  234.         BPS$ = MID$(Q$, R% - 4, 15)
  235.         L$ = NAM$ + DAT$ + "  " + TIM$ + "  " + TOS$ + "  " + BPS$
  236.         GOSUB 8000
  237.         Q$ = ""
  238.     END IF
  239.      NEXT I&
  240.      GOSUB 8200
  241.      RETURN
  242. 4600 '        LIST A CALLERS LOGINS
  243.      Lyn$ = "Name of caller to search for "
  244.      GOSUB 8400
  245.      IF LEN(CALR$) < 1 THEN 4600
  246.      CALR$ = UCASE$(CALR$)
  247.      FOR I& = LAST& TO 1 STEP -1
  248.      GOSUB 8300
  249.      W% = INSTR(N$, ONAT$)
  250.      IF W% <> 0 THEN
  251.          M% = 1
  252.          L% = 0
  253.      END IF
  254.      IF M% <> 0 THEN L% = INSTR(N$, CALR$)
  255.      IF L% <> 0 THEN
  256.          L$ = N$
  257.          GOSUB 8000
  258.      END IF
  259.      M% = 0
  260.      NEXT I&
  261.      GOSUB 8200
  262.      RETURN
  263. 4800 '        LIST KILLED MESSAGES
  264.      Varb$ = KILD$
  265.      GOSUB 7500
  266.      RETURN
  267. 5000 '        SEARCH FOR ANY STRING
  268.      Lyn$ = "Enter string for search "
  269.      GOSUB 8400
  270.      IF LEN(CALR$) < 1 THEN 5000
  271.      Varb$ = CALR$
  272.      GOSUB 7500
  273.      RETURN
  274. 7500 '        LIST VARIABLE SEARCH DATA
  275.      Varc$ = UCASE$(Varb$)
  276.      FOR I& = LAST& TO 1 STEP -1
  277.      GOSUB 8300
  278.      W% = INSTR(N$, ONAT$)
  279.      X% = INSTR(N$, LNT$)
  280.      IF W% <> 0 THEN
  281.          W$ = N$
  282.          M% = 1
  283.      END IF
  284.      IF X% <> 0 THEN X$ = N$
  285.      Y$ = UCASE$(N$)
  286.      K% = INSTR(Y$, Varc$)
  287.      IF K% <> 0 AND M% <> 0 THEN
  288.          L$ = W$
  289.          GOSUB 8000
  290.          L$ = X$
  291.          GOSUB 8000
  292.          M% = 0
  293.      END IF
  294.      IF K% <> 0 THEN
  295.          L$ = N$
  296.          GOSUB 8000
  297.      END IF
  298.      NEXT I&
  299.      GOSUB 8200
  300.      RETURN
  301. 8000 '
  302.      PRINT L$
  303.      CNT = CNT + 1
  304.      IF CNT < 23 THEN RETURN
  305.      CNT = 0
  306.      INPUT "--more--[y]/n"; CNT$
  307.      CNT$ = UCASE$(LEFT$(CNT$, 1))
  308.      IF CNT$ = "N" THEN I& = 0
  309.      RETURN
  310. 8200 '
  311.      PRINT ""
  312.      INPUT "That's all. Enter to continue.", CNT$
  313.      RETURN
  314. 8300 '
  315.      GET #1, I&
  316.      TEST$ = INKEY$
  317.      IF LEN(TEST$) = 0 THEN RETURN
  318.      IF ASC(TEST$) = 27 THEN I& = 1
  319.      RETURN
  320. 8400 '
  321.      LOCATE 20, 10
  322.      PRINT "Use the ESC key to halt search."
  323.      LOCATE 21, 10
  324.      PRINT Lyn$;
  325.      INPUT CALR$
  326.      PRINT
  327.      RETURN
  328. 9000 '
  329.      CLOSE
  330.      CLS
  331.      SYSTEM
  332. 9900 '
  333.      IF ERR <> 53 THEN               ' FILE NOT FOUND
  334.      PRINT "Error  "; ERR; "   at line  "; ERL
  335.      END
  336.      END IF
  337.      PRINT ""
  338.      INPUT "Callers file not found. Retry ? Y/N ", CNT$
  339.      CNT$ = UCASE$(LEFT$(CNT$, 1))
  340.      IF CNT$ = "Y" THEN RESUME 1000
  341.      IF CNT$ = "N" THEN RESUME 9000
  342.      GOTO 9900
  343.  
  344.