home *** CD-ROM | disk | FTP | other *** search
- 1 ' signon subsystem -- Comments Manager
- 3 VERSION$="1.00 {7/14/82}"
- 5 ' by dick lieber
- 6 SYSOPONLY%=0 '0 for anyone, 1 for sysop only
- 7 '
- 9 DEFDRIVE$="A:"
- 10 USERFILE$=DEFDRIVE$+"USERS"
- 11 CALLERFILE$="CALLERS"
- 15 LASTCALRFILE$="LASTCALR"
- 20 PWDFILE$="pwds"
- 21 SYSMGR$="POSYS"
- 50 USER0%=0
- 65 CRLF$=CHR$(&HA)+CHR$(&HD)
- 67 BSTRING$=CHR$(8)+" "+CHR$(8)
- 68 COMMENTFILE$="COMMENTS"
- 70 DIM ACLARRAY%(5,11)
- 71 DIM FLAGS%(14)
- 77 ON ERROR GOTO 1000
- 80 '
- 81 ' function definition
- 82 '
- 83 ' add deliminators to time or date
- 84 DEF FNADDSEP$(DS$,DELIM$)=
-
- LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
- 85 ' remove date or time deliminators
- 86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
- 88 ' on-off function
- 90 DIM ONOFF$(1)
- 91 ONOFF$(0)="Off"
- 92 ONOFF$(1)="On"
- 93 DEF FNONOFF$(ONOFF%)=ONOFF$(ONOFF%)
- 94 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
- 199 GOTO 10000
- 300 '
- 302 ' set user number
- 304 '
- 306 USERMD=TESTADDRESS+9
- 312 CALL USERMD(SETUSERNUMBER%)
- 345 RETURN
- 400 '
- 407 ' print a string on con:
- 414 ' string in A$, CR%=1 no crlf cr%=2 crlf after
- 435 ' 1.2
- 442 IF STACKED%<>0 THEN RETURN
- 449 BREAK%=0
- 456 XKEY$=INKEY$
- 463 IF XKEY$=CHR$(3) OR XKEY$="C" OR XKEY$="c" THEN BREAK%=1
- 470 IF XKEY$=CHR$(18) OR XKEY$="S" OR XKEY$="s" THEN PAUSE%=1 ELSE PAUSE%=0
- 477 IF PAUSE%<>0 AND LEN(INKEY$)=0 THEN GOTO 477 'wait for key
- 484 ON CR% GOTO 491,498
- 491 PRINT A$; : RETURN
- 498 PRINT A$: RETURN
- 500 '
- 503 ' get a string into ANSWER$ (make upper case)
- 512 ' 1.7 [*** tremendously improved! ***]
- 515 IF STACKED%<>0 THEN
-
- ANSWER$=STACKED$:
-
- STACKED%=0:
-
- NKEY%=LEN(STACKED$):
-
- GOTO 557
- 518 ANSWER$=""
- 521 KEY$="*"
- 524 NKEY%=0
- 527 WHILE NKEY% <= MAX%
- 530 KEY$=INPUT$(1)
- 533 KEY%=ASC(KEY$)
- 536 IF KEY$="~" THEN GOTO 551 'don't allow tilde
- 539 IF KEY%=13 THEN GOTO 557 'done
- 542 IF (KEEPLOWER%=0 AND KEY% >= 97 AND KEY%<= 122) THEN KEY%=KEY%-32
- 545 IF KEY%=127 OR KEY%=8 THEN GOSUB 569 'process backspace
- 548 IF DELCHAR%=0 THEN
-
- NKEY%=NKEY%+1:
-
- PRINT KEY$;:
-
- ANSWER$=ANSWER$+CHR$(KEY%)
-
- ELSE
-
- DELCHAR%=0
- 551 IF NKEY%<0 THEN NKEY%=0
- 554 WEND
- 557 STACKED%=INSTR(ANSWER$,";")
- 560 IF STACKED%<>0 THEN
-
- STACKED$=MID$(ANSWER$,STACKED%+1):
-
- ANSWER$=LEFT$(ANSWER$,STACKED%-1)
- 563 KEEPLOWER%=0
- 566 RETURN
- 569 DELCHAR%=1
- 572 IF NKEY%=0 THEN RETURN
- 575 NKEY%=NKEY%-1
- 578 PRINT BSTRING$;
- 581 ANSWER$=LEFT$(ANSWER$,LEN(ANSWER$)-1)
- 584 RETURN
- 700 '
- 705 ' get string into ANSWER$ then CRLF
- 710 '
- 715 GOSUB 500: PRINT: RETURN
- 800 '
- 810 ' print a file
- 820 ' filename in FIL$
- 821 ' NOCTLC% <> 0 to not allow ^C to skip
- 830 ' 1.6
- 833 IF SKIPFILES%=1 THEN RETURN
- 837 IF FIL$="NONE" THEN RETURN
- 838 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
- 839 NOFILE%=0
- 840 OPEN "I",2,DRIVE$+FIL$:BK=0
- 842 IF NOFILE%<>0 THEN RETURN
- 845 IF NOCTLC% = 0 THEN
-
- A$=CRLF$+"Ctrl-C to skip ahead."+CRLF$: GOSUB 400
- 850 CR%=2
- 860 IF EOF(2) OR (BREAK% AND NOCTLC%=0) THEN
-
- 870 ELSE LINE INPUT #2,A$:GOSUB 400:GOTO 860
- 870 CLOSE #2
- 875 NOCTLC%=0
- 880 RETURN
- 1000 '
- 1004 ' Error handler
- 1008 '
- 1012 A$="Error Trap":CR%=2: GOSUB 400
- 1016 IF ERR=53 AND ERL=1135 THEN RESUME 1150
- 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
- 1022 IF ERR=53 THEN NOFILE%=1
- 1024 IF ERR = 53 THEN RESUME NEXT ' file not found
- 1028 END
- 1100 ' get passwords & configuration parameters
- 1110 ' 1.4
- 1115 NOFILE%=0
- 1120 OPEN "I", #2,DEFDRIVE$+PWDFILE$'caution line # must = in sub 1000
- 1125 IF NOFILE%<>0 THEN CLOSE #1: RETURN
- 1130 INPUT #2, PWD1$, PWD2$, PWD3$, ALLOWNEW%, SIGNONMESS$, OPTIONMESS$
- 1135 INPUT #2,BULLFILE$, SUCESSFILE$, OPTIONFILE$, INSTRFILE$,
-
- NEWCOMFILE$, NOACCESSFILE$, EXITFILE$,SPECIALFILE$
- 1140 INPUT #2,PWDACL%, MAXPW%, SYSOPSLVL%, USERNUMBER%, DENIEDCOMMENT%
- 1145 INPUT #2, CLEARSCR$,NOCLOCK%,SPECIALEVEL%
- 1150 INPUT #2, MUSTQUALIFY%, QUALQUESTION$, QUALANSWER1$, QUALANSWER2$,
-
- QUALNONPWD%, MGRDRIVE$
- 1155 INPUT #2, SKIPFILES%,RAMPOKE%,RAMPOKEADDRESS%,TESTADDRESS
- 1160 INPUT #2, BYEPOKE%, BYEPARAMS%
- 1165 FOR INDEX%=0 TO 4:
-
- FOR I%=0 TO 10:
-
- INPUT #2,ACLARRAY%(INDEX%,I%):
-
- NEXT I%:
-
- NEXT INDEX%
- 1170 CLOSE #2
- 1175 RETURN
- 1600 '
- 1602 ' date process and time
- 1604 ' 1.1
- 1606 ' on entry:
- 1608 '
- 1610 ' GETDAY% <> 0 if day of week is required
- 1612 ' NOCLOCK% <> 0 to return dummy values (no TOD clock)
- 1614 '
- 1616 ' returns:
- 1618 '
- 1620 ' DATE$ as mmddyy
- 1622 ' TIME$ as hhmmss
- 1624 ' DOW$ as string with day of week (Monday, Tuesday, etc.)
- 1626 '
- 1628 ' as written here, calls are made to externally linked
- 1630 ' modules:
- 1632 '
- 1634 ' TIMEMD returns "HH:MM:SS"
- 1636 ' DATEMD returns "DD/MM/YY"
- 1638 ' DAYMD returns "dayofweekstring" (ie: Monday, Tuesday, etc.)
- 1640 ' seperators must be present
- 1642 '
- 1644 TIMEMD=TESTADDRESS
- 1646 DATEMD=TESTADDRESS+3
- 1648 DAYMD=TESTADDRESS+6
- 1650 IF NOCLOCK%<>0 THEN
-
- DATE$="xxxxxx":
-
- TIME$="xxxxxx":
-
- DAY$="":
-
- RETURN
- 1651 ODATE$=STRING$(12,"$")
- 1652 CALL DATEMD(ODATE$)
- 1654 DATE$=FNKILLSEP$(LEFT$(ODATE$,8))
- 1656 '
- 1658 ' get time
- 1660 '
- 1661 OTIME$=STRING$(12,"$")
- 1662 CALL TIMEMD(OTIME$)
- 1664 TIME$=FNKILLSEP$(LEFT$(OTIME$,8))
- 1666 '
- 1668 ' get day of week
- 1670 '
- 1672 DAY$=""
- 1674 IF GETDAY%=0 THEN RETURN
- 1676 ODAY$=STRING$(10,"$")
- 1678 CALL DAYMD(ODAY$)
- 1680 FOR I%=1 TO LEN(ODAY$)
- 1682 IF MID$(ODAY$,I%,1)<>"$" THEN DAY$=DAY$+MID$(ODAY$,I%,1)
- 1684 NEXT I%
- 1686 GETDAY%=0
- 1688 RETURN
- 3100 '
- 3105 ' clear screen
- 3110 '
- 3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
- 3300 '
- 3305 ' make selection
- 3310 '
- 3315 MAX%=0:GOSUB 500
- 3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
- 3325 SELECTION%=ASC(ANSWER$)-64
- 3327 IF SELECTION% < 0 THEN SELECTION%=0
- 3330 RETURN
- 4700 '
- 4705 ' pause
- 4710 '
- 4715 PRINT:PRINT TAB(25);
- 4720 LINE INPUT "Press RETURN to continue."; A$
- 4725 RETURN
- 5000 '
- 5005 ' test that user is the SYSOP
- 5010 '
- 5015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
- 5020 INPUT #1, FRNAME$,LNAME$,ACLVL%
- 5025 CLOSE #1
- 5030 IF FRNAME$+LANME$ = "SYSOP" AND ACLVL% => 9 THEN ZRETURN%=1
-
- ELSE ZRETURN%=0
- 5035 RETURN
- 5100 '
- 5105 ' COMMENTFILE$ maintainer - main menu
- 5110 '1.2
- 5115 GOSUB 3100
- 5120 PRINT TAB(30);COMMENTFILE$;" Manager"
- 5122 PRINT TAB(22);"Version: ";VERSION$
- 5125 PRINT FNLINES$(3); TAB(20);"a View comments.";
- 5130 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT " [New ";
- 5135 IF SYSCOM$="*" THEN PRINT "system ";
- 5140 IF SYSCOM$="*" AND NEWCOM$="*" THEN PRINT "and ";
- 5145 IF NEWCOM$="*" THEN PRINT "user ";
- 5150 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT "comments]" ELSE
-
- PRINT
- 5155 PRINT FNLINES$(1); TAB(20);"b Delete comments."
- 5160 PRINT FNLINES$(1); TAB(20);"c Make typeable archive of COMMENTS."
- 5165 PRINT FNLINES$(1); TAB(20);"d View a COMMENTS archive file."
- 5170 PRINT FNLINES$(1); TAB(20);"e Jump back to Signon Manager."
- 5172 PRINT: PRINT FNLINES$(1); TAB(20);"q Quit Comments Manager."
- 5175 PRINT FNLINES$(3); TAB(20);"Press letter of your choice > ";
- 5180 GOSUB 3300
- 5190 RETURN
- 5300 '
- 5304 ' exit subsystem manager
- 5308 '
- 5310 SETUSERNUMBER%=0:GOSUB 300
- 5316 END
- 7600 '
- 7605 ' leave comments manager
- 7610 '
- 7612 SETUSERNUMBER%=0: GOSUB 300
- 7615 END
- 7700 '
- 7704 ' jumpout to posys
- 7708 '
- 7710 SETUSERNUMBER%=0: GOSUB 300
- 7712 JUMPFILE$=SYSMGR$
- 7716 GOSUB 7800
- 7720 RETURN
- 7800 '
- 7807 ' generalized jumpout (chain)
- 7814 '1.2
- 7821 GOSUB 3100
- 7822 CLOSE
- 7828 PRINT FNLINES$(4)
- 7835 PRINT TAB(20);"Chaining to ";JUMPFILE$;"."
- 7842 PRINT FNLINES$(2)
- 7849 PRINT TAB(20);"Please wait."
- 7856 CHAIN JUMPFILE$
- 7863 GOSUB 3100
- 7870 PRINT FNLINES$(4)
- 7877 PRINT TAB(25); JUMPFILE$;" is not available."
- 7884 GOSUB 4700
- 7891 RETURN
- 7900 '
- 7905 ' open comments file
- 7910 ' get comment parameters from header
- 7915 ' 1.5
- 7920 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
- 7925 OPEN "R", #3, DEFDRIVE$+COMMENTFILE$, 66
- 7930 FIELD #3,
-
- 5 AS COMMENTNUMBER$,
-
- 8 AS TOTCOMMT$,
-
- 1 AS COMSIG$,
-
- 6 AS FCOMDATE$,
-
- 6 AS FCOMTIME$,
-
- 1 AS FINEWCOM$,
-
- 1 AS FSYSCOM$
- 7935 GET #3,1
- 7940 NEXTCOMMENT%=VAL(COMMENTNUMBER$)
- 7945 TOTALCOMMENTS#=VAL(TOTCOMMT$)
- 7950 COMTIME$=FCOMTIME$
- 7955 NEWCOM$=FINEWCOM$
- 7960 COMDATE$=FCOMDATE$
- 7965 SYSCOM$=FSYSCOM$
- 7975 IF COMSIG$<>"*" THEN
-
- NEXTCOMMENT%=2:
-
- TOTALCOMMENTS#=1:
-
- GOSUB 1600:
-
- COMTIME$=TIME$:
-
- COMDATE$=DATE$:
-
- NOCOMMENTS%=1
- 7977 IF HEADONLY%<>0 THEN
-
- HEADONLY%=0:
-
- RETURN
- 7980 FIELD #3, 64 AS COMMENT$
- 7985 RETURN
- 8000 '
- 8003 ' get a line from the COMMENTFILE$
- 8006 '
- 8007 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
- 8010 GET #3, COMREC%
- 8015 COMMENTLINE$=COMMENT$
- 8017 IF RIGHT$(COMMENTLINE$,1)=" " THEN
-
- COMMENTLINE$=LEFT$(COMMENTLINE$,LEN(COMMENTLINE$)-1):
-
- GOTO 8017
- 8021 IF LEFT$(COMMENTLINE$,1)="~" THEN
-
- COMMENTLINE$=RIGHT$(COMMENTLINE$,LEN(COMMENTLINE$)-1):
-
- COMMENTCOUNT%=COMMENTCOUNT%+1:
-
- HEADER%=1
-
- ELSE
-
- HEADER%=0
- 8040 RETURN
- 8100 '
- 8104 ' check for new comments
- 8108 '
- 8110 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
- 8112 OPEN "R", #3,DEFDRIVE$+COMMENTFILE$, 66
- 8116 FIELD #3,
-
- 5 AS COMMENTNUMBER$,
-
- 8 AS TOTCOMMT$,
-
- 1 AS COMSIG$,
-
- 6 AS FCOMDATE$,
-
- 6 AS FCOMTIME$,
-
- 1 AS FINEWCOM$,
-
- 1 AS FSYSCOM$
- 8117 GET #3,1
- 8120 IF COMSIG$="*" THEN
-
- NEWCOM$=FINEWCOM$:
-
- SYSCOM$=FSYSCOM$
- 8124 CLOSE #3
- 8128 RETURN
- 8200 '
- 8203 ' write COMMENTFILE$ to a comments archeive file
- 8206 ' named DATE.CMT
- 8209 '
- 8212 GOSUB 1600
- 8215 GOSUB 3100
- 8218 PRINT:PRINT TAB(15);
-
- "Making an archeive of any comments in the file COMMENTS."
- 8221 PRINT:PRINT TAB(15);
-
- "The new file will be called ";FNADDSEP$(DATE$,"/");".CMT"
- 8224 GOSUB 7900
- 8227 IF NOCOMMENTS%<>0 THEN PRINT:PRINT TAB(20);"No comments in file.":
-
- PRINT: GOSUB 4700:
-
- RETURN
- 8230 SETUSERNUMBER%=0: GOSUB 300:
-
- OPEN "O", #2, MGRDRIVE$+FNADDSEP$(DATE$,"/")+".CMT"
- 8233 COMMENTCOUNT%=0
- 8236 PRINT
- 8239 FOR COMREC%=2 TO NEXTCOMMENT%-1
- 8242 GOSUB 8000 'get a line
- 8245 SETUSERNUMBER%=0:GOSUB 300
- 8248 IF HEADER%=0 THEN
-
- PRINT #2, COMMENTLINE$
-
- ELSE
-
- PRINT #2,"":
-
- PRINT #2,COMMENTLINE$
- 8251 PRINT ".";
- 8254 NLINES%=NLINES%+1
- 8257 NEXT COMREC%
- 8260 PRINT
- 8263 CLOSE #2
- 8266 PRINT:PRINT TAB(15); COMMENTCOUNT%; "comments, consisting of";NLINES%;:
-
- PRINT TAB(15); "lines written to the ";
-
- FNADDSEP$(DATE$,"/");".CMT file."
- 8269 CLOSE #3
- 8272 PRINT:PRINT "These are the archeive COMMENTS files on this disk/user:"
- 8275 PRINT:SETUSERNUMBER%=0: GOSUB 300
- 8278 FILES MGRDRIVE$+"????????.CMT"
- 8281 IF NOFILE%=1 THEN PRINT "No COMMENTS archeives."
- 8284 PRINT: GOSUB 4700
- 8287 RETURN
- 8300 '
- 8304 ' display comments from COMMENTFIL$
- 8308 '1.1
- 8312 GOSUB 3100
- 8314 PRINT TAB(10);"Press ^K to abort listing."
- 8316 GOSUB 7900 'open COMMENTFILE$
- 8320 COMMENTCOUNT%=0
- 8324 IF NOCOMMENTS%=1 THEN
-
- PRINT FNLINES$(1); TAB(20);"The COMMENTS file is empty":
-
- PRINT TAB(20);"Total comments: ";TOTALCOMMENTS#-1:
-
- PRINT FNLINES$(2); :GOSUB 4700:
-
- RETURN
- 8328 FOR COMREC%=2 TO NEXTCOMMENT%-1
- 8330 IF INKEY$=CHR$(&HB) THEN ABORT%=1 ELSE ABORT%=0
- 8332 GOSUB 8000 'get comment line
- 8336 IF HEADER%=0 THEN
-
- PRINT COMMENTLINE$
-
- ELSE
-
- PRINT:
-
- PRINT COMMENTLINE$
- 8338 IF ABORT%<>0 THEN COMREC%=NEXTCOMMENT%-1
- 8340 NEXT COMREC%
- 8344 CLOSE #3
- 8345 IF ABORT%<>0 THEN PRINT FNLINES$(2); TAB(20); "** aborted **"
- 8348 PRINT:PRINT TAB(10);"Number of comments displayed:";COMMENTCOUNT%
- 8352 PRINT TAB(10);" Total number of comments:";TOTALCOMMENTS#-1
- 8353 IF ABORT%<>0 THEN PRINT: GOSUB 4700: RETURN
- 8356 HEADONLY%=1: GOSUB 7900
- 8360 LSET FINEWCOM$="": NEWCOM$=""
- 8364 LSET FSYSCOM$="": SYSCOM$=""
- 8368 PUT #3,1
- 8369 GET #3,2
- 8372 CLOSE #3
- 8376 PRINT: GOSUB 4700
- 8380 RETURN
- 8400 '
- 8404 ' view a COMMENTS archeive
- 8408 '
- 8412 NOFILE%=0
- 8416 GOSUB 3100
- 8420 PRINT:PRINT TAB(10);"These are the available COMMENT archieves:"
- 8424 PRINT: SETUSERNUMBER%=0: GOSUB 300:
-
- FILES MGRDRIVE$+"????????.CMT"
- 8428 IF NOFILE%<>0 THEN PRINT TAB(20);"No archeives on disk/user.":
-
- PRINT: GOSUB 4700: RETURN
- 8432 PRINT:PRINT:PRINT "Type date of archeive to view > ";: MAX%=8:GOSUB 500
- 8436 IF NKEY%=0 THEN RETURN
- 8440 FIL$=ANSWER$+".CMT": DRIVE$=MGRDRIVE$
- 8444 GOSUB 3100
- 8448 SWAP USER0%,USERNUMBER%:
-
- GOSUB 800:
-
- SWAP USER0%,USERNUMBER%
- 8452 IF NOFILE%<>0 THEN PRINT TAB(20); FIL$;" doesn't exist.":
-
- PRINT: GOSUB 4700: GOTO 8400
- 8456 PRINT: GOSUB 4700
- 8460 RETURN
- 8500 '
- 8504 ' remove all comments from COMMENTFILE$
- 8508 '
- 8512 GOSUB 3100
- 8516 GOSUB 7900 'open COMENTFILE$
- 8520 OLDTOTAL#=TOTALCOMMENTS#
- 8524 IF NOCOMMENTS%<>0 THEN
-
- PRINT:PRINT TAB(20);"There are no comments to delete.":
-
- PRINT:PRINT TAB(20);"Total comments so far:";OLDTOTAL#:
-
- CLOSE #3:
-
- PRINT: GOSUB 4700:
-
- RETURN
- 8525 CLOSE #3
- 8526 PRINT TAB(10);"Press d to delete current comments."
- 8527 MAX%=0: GOSUB 500: IF ANSWER$<>"D" THEN RETURN
- 8528 PRINT : PRINT TAB(20);"Removing comments."
- 8536 KILL DEFDRIVE$+COMMENTFILE$
- 8540 HEADONLY%=1: GOSUB 7900
- 8544 LSET COMMENTNUMBER$ = STR$(2)
- 8548 LSET TOTCOMMT$ = STR$(OLDTOTAL#)
- 8552 LSET COMSIG$="*"
- 8556 PUT #3,1
- 8560 CLOSE #3
- 8564 RETURN
- 10000 '
- 10010 ' main program starts here
- 10020 ' 1.0
- 10030 IF SYSOPONLY%=1 THEN GOSUB 5000 ELSE ZRETURN%=1
- 10040 IF ZRETURN%=0 THEN PRINT "POSYS?": END
- 10050 GOSUB 1100
- 10055 GOSUB 8100
- 10060 IF NOFILE%<> 0 THEN PRINT "Bad start - See SIGNON.DOC": END
- 10070 GOSUB 5100
- 10080 IF SELECTION%=17 THEN GOTO 7600
- 10090 ON SELECTION% GOSUB 8300,8500,8200,8400,7700
- 10100 GOTO 10070
- 10110 END
- 20000 ' the end
- ELECTION%=17 THEN GOTO 7600
- 10090 ON SELECTION% GOSUB 8300,8500,8200,8400,7700
- 101