home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / rlimail / rlimail.bas next >
BASIC Source File  |  1990-05-16  |  8KB  |  94 lines
  1. 1 '+--------------------------------------------------------------------------+
  2. 2 '|                                                                          |
  3. 3 '|    W0RLI MailBox Mail Header Report Utility - Version 2.10 - (C) WB2COY  |
  4. 4 '|    Latest revision - 05/15/90                       All Rights Reserved  |
  5. 5 '|                                                                          |
  6. 6 '+--------------------------------------------------------------------------+
  7. 20 KEY OFF: CLS : GOSUB 610: PRINT : INPUT "Enter Name of Mail File (Default = MAIL.MB)"; A$: PRINT : IF A$ = "" THEN A$ = "MAIL.MB"
  8. 30 I = 0: Y = 0: X = 0: CLS : GOSUB 610: PRINT : PRINT "Report on Messages:": PRINT : PRINT "(A)ctive"; TAB(30); : PRINT "(B)ulletins": PRINT "(D)ate"; TAB(30); : PRINT "(F)orwarded": PRINT "(H)eld"; TAB(30); : PRINT "(K)illed"
  9. 35 PRINT "(O)ld"; TAB(30); : PRINT "(R)ead": PRINT
  10. 40 PRINT "(T) NTS Traffic"; TAB(30); : PRINT "(>) TO": PRINT "(<) FROM"; TAB(30); : PRINT "(@) AT ": PRINT "(?) Find Text in Subject": PRINT : PRINT "(X) Exit Program": PRINT : INPUT "Your Choice "; B$: GOSUB 620
  11. 50 IF B$ = "" THEN 30 ELSE IF B$ = "R" THEN B$ = "Y" ELSE IF B$ = "X" THEN CLS : CLOSE : END
  12. 60 IF B$ = "<" OR B$ = ">" OR B$ = "@" THEN PRINT : INPUT "Enter CALLSIGN "; CALLSIGN$ ELSE 80
  13. 70 IF LEN(CALLSIGN$) > 6 THEN PRINT "Invalid Input": GOTO 60 ELSE GOSUB 640: CALS$ = CALLSIGN$: CALLSIGN$ = CALLSIGN$ + STRING$(7 - LEN(CALLSIGN$), " ")
  14. 80 IF B$ = "?" THEN PRINT : INPUT "Enter Text String to Find "; AA$: GOSUB 760
  15. 85 IF B$ = "D" THEN PRINT : INPUT "Enter Date to Find (MMDD)"; AD$: IF LEN(AD$) > 4 THEN 85
  16. 90 IF INSTR("ADYHZKROFBT<>@?", B$) = 0 THEN PRINT "Valid responses are A,K,R,O,H,F,B,D,T,<,>,@, or X": GOTO 590
  17. 100 PRINT : INPUT "<H>ardcopy <F>ile or <D>isplay (H F or D) "; C$: CLS : GOSUB 630: GOSUB 610
  18. 110 IF C$ = "" THEN C$ = "D" ELSE IF INSTR("HhFfDd", C$) = 0 THEN 100
  19. 120 IF C$ = "F" THEN CLOSE 2: GOSUB 700: OPEN RPT$ FOR OUTPUT AS #2: PRINT #2, "W0RLI Mail Header Report Utility - WB2COY - "; DATE$; " - "; TIME$: PRINT #2, " ": PRINT #2, " Msg #  NR Stat  Size To     From   @ BBS  Date Subject"
  20. 130 'IF C$="D" THEN PRINT" Msg #  NR Stat  Size To     From   @ BBS  Date Subject"
  21. 140 IF C$ = "H" THEN LPRINT "W0RLI Mail Header Report Utility - WB2COY - Printed "; DATE$; " - "; TIME$: LPRINT : LPRINT " Msg #  NR Stat  Size To     From   @ BBS  Date Subject"
  22. 150 CLOSE 1: OPEN "R", 1, A$, 512
  23. 160 FIELD 1, 2 AS RN$, 2 AS NR$, 2 AS MN$, 2 AS SZ$, 1 AS AT$, 1 AS AS$, 7 AS A2$, 7 AS A3$, 7 AS A4$, 7 AS A5$, 5 AS A6$, 7 AS A7$, 2 AS A8$, 80 AS A9$, 118 AS GB2$, 128 AS GB3$, 128 AS GB4$
  24. 170 FOR I = FIX((LOF(1) / 512) + 1) TO 1 STEP -1
  25. 180 GET 1, I
  26. 190 IF I < 1 THEN 200 ELSE IF C$ = "F" OR C$ = "H" THEN LOCATE 10, 26: PRINT "Processing Record # "; I
  27. 200 IF INSTR("BFTPA$", AT$) = 0 THEN 570
  28. 210 TYPE$ = AT$
  29. 220 IF AS$ = CHR$(128) THEN ST$ = "$"
  30. 230 IF AS$ = CHR$(130) THEN ST$ = "F"
  31. 240 IF AS$ = CHR$(2) THEN ST$ = "F"
  32. 250 IF AS$ = CHR$(1) THEN ST$ = "Y"
  33. 260 IF AS$ = CHR$(32) THEN ST$ = "O"
  34. 270 IF AS$ = CHR$(134) THEN ST$ = "K"
  35. 280 IF AS$ = CHR$(5) THEN ST$ = "KY"
  36. 290 IF AS$ = CHR$(132) THEN ST$ = "K"
  37. 300 IF AS$ = CHR$(100) THEN ST$ = "KHO"
  38. 310 IF AS$ = CHR$(69) THEN ST$ = "KYH"
  39. 320 IF AS$ = CHR$(38) THEN ST$ = "KFO"
  40. 330 IF AS$ = CHR$(4) THEN ST$ = "K"
  41. 340 IF AS$ = CHR$(6) THEN ST$ = "KF"
  42. 350 IF AS$ = CHR$(36) THEN ST$ = "KO"
  43. 360 IF AS$ = CHR$(65) THEN ST$ = "H"
  44. 370 IF AS$ = CHR$(64) THEN ST$ = "H"
  45. 380 IF AS$ = CHR$(96) THEN ST$ = "HO"
  46. 390 IF AS$ = CHR$(0) THEN ST$ = " "
  47. 400 STATUS$ = TYPE$ + ST$: STATUS$ = STATUS$ + STRING$(4 - LEN(STATUS$), " ")
  48. 410 SUBJ$ = LEFT$(A9$, INSTR(A9$, CHR$(0)))
  49. 420 IF CVI(MN$) < 0 THEN MSG$ = STR$(65536 - ABS(CVI(MN$))) ELSE MSG$ = STR$(ABS(CVI(MN$)))
  50. 425 MSG$ = STRING$(6 - LEN(MSG$), " ") + MSG$ + " "
  51. 430 SIZE$ = STR$(ABS(CVI(SZ$))): SIZE$ = STRING$(6 - LEN(SIZE$), " ") + SIZE$
  52. 440 NUMR$ = STR$(ABS(CVI(NR$))): NUMR$ = STRING$(3 - LEN(NUMR$), " ") + NUMR$ + " "
  53. 450 TOCALL$ = LEFT$(A2$, INSTR(A2$, CHR$(0)) - 1): TOCALL$ = TOCALL$ + STRING$(7 - LEN(TOCALL$), " ")
  54. 460 FRCALL$ = LEFT$(A3$, INSTR(A3$, CHR$(0)) - 1): FRCALL$ = FRCALL$ + STRING$(7 - LEN(FRCALL$), " ")
  55. 470 DAT$ = LEFT$(A5$, INSTR(A5$, CHR$(0)) - 1): DAT$ = RIGHT$(DAT$, 4): TIM$ = LEFT$(A6$, INSTR(A6$, CHR$(0)) - 1)
  56. 480 BBS$ = LEFT$(A4$, INSTR(A4$, CHR$(0)) - 1): BBS$ = BBS$ + STRING$(7 - LEN(BBS$), " "): 'IF LEFT$(BBS$,1)=CHR$(0) THEN BBS$="       "
  57. 490 IF B$ = "A" AND (LEFT$(ST$, 1) <> "K" AND LEFT$(ST$, 1) <> "H") THEN GOSUB 660
  58. 500 IF B$ = AT$ AND LEFT$(ST$, 1) <> "K" THEN GOSUB 660
  59. 510 IF B$ = "Z" THEN GOSUB 660
  60. 520 IF LEFT$(ST$, 1) = B$ THEN GOSUB 660
  61. 530 IF (B$ = "<" AND FRCALL$ = CALLSIGN$) AND LEFT$(ST$, 1) <> "K" THEN GOSUB 660
  62. 540 IF (B$ = ">" AND TOCALL$ = CALLSIGN$) AND LEFT$(ST$, 1) <> "K" THEN GOSUB 660
  63. 550 IF (B$ = "@" AND BBS$ = CALLSIGN$) AND LEFT$(ST$, 1) <> "K" THEN GOSUB 660
  64. 560 IF B$ = "?" AND (INSTR(SUBJ$, AA$) <> 0 OR INSTR(SUBJ$, AB$) <> 0 OR INSTR(SUBJ$, AC$) <> 0 OR INSTR(SUBJ$, AD$) <> 0) AND LEFT$(ST$, 1) <> "K" THEN GOSUB 660
  65. 565 IF (B$ = "D" AND DAT$ = AD$) AND LEFT$(ST$, 1) <> "K" THEN GOSUB 660
  66. 570 NEXT I
  67. 580 CLOSE : PRINT : PRINT "                        "; X; " Record(s) Found"
  68. 590 PRINT : PRINT "                         [Hit Any Key to Continue]"
  69. 600 Z$ = INKEY$: IF Z$ = "" THEN 600 ELSE CLS : GOTO 30
  70. 610 LOCATE 25, 1: PRINT "W0RLI MailBox Mail Header Report Utility - Version 2.10        (C) 1990 - WB2COY": LOCATE 1, 1: RETURN
  71. 620 IF B$ = "" THEN RETURN ELSE IF ASC(B$) > 96 AND ASC(B$) < 123 THEN B$ = CHR$(ASC(B$) - 32): RETURN ELSE RETURN
  72. 630 IF C$ = "" THEN RETURN ELSE IF ASC(C$) > 96 AND ASC(C$) < 123 THEN C$ = CHR$(ASC(C$) - 32): RETURN ELSE RETURN
  73. 640 FOR I = 1 TO LEN(CALLSIGN$): D$ = (MID$(CALLSIGN$, I, 1)): IF ASC(D$) > 96 AND ASC(D$) < 123 THEN MID$(CALLSIGN$, I, 1) = CHR$(ASC(D$) - 32):  ELSE MID$(CALLSIGN$, I, 1) = CHR$(ASC(D$))
  74. 650 NEXT I: RETURN
  75. 660 IF (Y = 0 AND C$ = "D") THEN GOSUB 750 ELSE IF (Y = 20 AND C$ = "D") THEN GOSUB 820
  76. 670 Y = Y + 1: X = X + 1: IF C$ = "D" THEN PRINT MSG$; NUMR$; STATUS$; SIZE$; " "; TOCALL$; FRCALL$; BBS$; DAT$; " "; LEFT$(SUBJ$, 31): RETURN:  ELSE IF C$ = "H" THEN GOSUB 680: RETURN:  ELSE IF C$ = "F" THEN GOSUB 690: RETURN ELSE RETURN
  77. 680 LPRINT MSG$; TAB(8); NUMR$; TAB(12); STATUS$; TAB(17); RIGHT$(SIZE$, 5); TAB(23); TOCALL$; TAB(30); FRCALL$; TAB(37); BBS$; TAB(44); DAT$; TAB(49); LEFT$(SUBJ$, 31): RETURN
  78. 690 PRINT #2, MSG$; NUMR$; STATUS$; SIZE$; " "; TOCALL$; FRCALL$; BBS$; DAT$; " "; LEFT$(SUBJ$, 31): RETURN
  79. 700 RPT$ = "RLIMAIL.RPT": IF INSTR("<>@", B$) > 0 THEN RPT$ = CALS$ + ".RPT"
  80. 710 IF B$ = "K" THEN RPT$ = "RLI-KILL.RPT" ELSE IF B$ = "A" THEN RPT$ = "RLI-ACT.RPT" ELSE IF B$ = "O" THEN RPT$ = "RLI-OLD.RPT" ELSE IF B$ = "R" THEN RPT$ = "RLIREAD.RPT" ELSE IF B$ = "H" THEN RPT$ = "RLI-HELD.RPT"
  81. 715 IF B$ = "B" THEN RPT$ =  "RLI-BULL.RPT"
  82. 720 IF B$ = "T" THEN RPT$ = "RLI-NTS.RPT" ELSE IF B$ = "F" THEN RPT$ = "RLI-FWD.RPT" ELSE IF B$ = "Y" THEN RPT$ = "RLI-READ.RPT"
  83. 730 PRINT " Writing Records to file: "; RPT$
  84. 740 RETURN
  85. 750 PRINT " Msg #  NR Stat  Size To     From   @ BBS  Date Subject": RETURN
  86. 760 AB$ = AA$: FOR I = 1 TO LEN(AB$): D$ = (MID$(AB$, I, 1)): IF ASC(D$) > 96 AND ASC(D$) < 123 THEN MID$(AB$, I, 1) = CHR$(ASC(D$) - 32):  ELSE MID$(AB$, I, 1) = CHR$(ASC(D$))
  87. 770 NEXT I
  88. 780 AC$ = AA$: FOR I = 1 TO LEN(AC$): D$ = (MID$(AC$, I, 1)): IF ASC(D$) > 64 AND ASC(D$) < 91 THEN MID$(AC$, I, 1) = CHR$(ASC(D$) + 32):  ELSE MID$(AC$, I, 1) = CHR$(ASC(D$))
  89. 790 NEXT I
  90. 800 AD$ = AC$: D$ = (LEFT$(AD$, 1)): IF ASC(D$) > 96 AND ASC(D$) < 123 THEN MID$(AD$, 1) = CHR$(ASC(D$) - 32)
  91. 810 RETURN
  92. 820 PRINT : PRINT "                  <Any Key to Continue - Q to Quit>"
  93. 830 Z$ = INKEY$: IF Z$ = "" THEN 830 ELSE IF Z$ = "Q" OR Z$ = "q" THEN 580 ELSE Y = 1: CLS : GOSUB 610: GOSUB 750: RETURN
  94.