home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-07-14 | 25.2 KB | 1,568 lines |
- LEGE "Scripted BBS (1.3); initializing"
- WOPE 10,1 12,78 (default)
- ATSA 11,3 (default) "Initializing BBS.. "
- S20="_PARM"(11:14)*","*"_PARM"(0:3)
- S21="ATE0Q0V1X1S0=2 S7=30 S9=10^M"
- S22="\BBS"
- S23="\BBS\FILES"
- S24="\BBS\MAIL"
- S25="\BBS\BULLETIN"
- S26=""
- SET PARI NONE
- SET DATA 8
- SET STOP 1
- SET MASK ON
- SET CR_I CR_L
- SET ASCI UP_L LF
- SET SOFT ON
- SET ZMOD AUTO OFF
- SET ZMOD RECO OFF
- IF ISSC "BBSDAT"
- FCAL "BBSDAT"
- ELSE
- S10="_SCRIPT"
- GOSU Parse_Fn
- S10=S10*"\BBSDAT"
- IF ISSC S10 FCALL S10
- ENDI
- SUBD S29
- DLDI S28
- IF NOT ISFILE S22*"\BBS-User"
- WCLO
- GOTO NoUser
- ENDI
- SET PORT S20(0:3)
- SET INAF OFF
- SET ALAR OFF
- SET ATIM 1
- CHDI S22
- SET DLDI S23
- LEGE "Scripted BBS (1.3); Press ESC to terminate or to CHAT."
- WCLO
- ON ESCA GOSU Escape
- SET PORT S20(0:3)
- IF ISFILE "HOSTTEMP.STR" and ISFILE "HOSTTEMP.BAT"
- SET RECH ON
- LOAD STRING "HOSTTEMP.STR"
- SET FLAG(1) S0(0:2)
- SET FLAG(2) S0(3:5)
- SET FLAG(3) S0(6:8)
- DELE "HOSTTEMP.STR"
- S9="* Return from drop-to-DOS"
- GOSU Log_Item
- CLOG S9
- GOTO Main_Pro
- ENDI
- TRAN "_MESCAPE"
- SET BAUD S20(5:8)
- S9="* BBS script loaded"
- CLOG S9
- GOSU Log_Item
- GOTO Restart
- Parse_Fn:
- LENG S10 N10
- FOR N11=(N10-1),0,-1
- IF STRCMP S10(N11:N11) ":" or STRCMP S10(N11:N11) "\" GOTO PAFN100
- ENDF
- S11=S10
- S10=""
- RETU
- PAFN100:
- S11=S10(N11+1:N10)
- IF STRCMP S10(N11:N11) "\" DEC N11
- S10=S10(0:N11)
- RETU
- NoUser:
- LEGE "Scripted BBS (1.3); Error initializing"
- WOPE 10,10,17,70 (default) NoUser_E
- ATSA 10,12 (default) " BBS initialization "
- ATSA 11,12 (default) "There is no user ID file (BBS-User) to be found on the"
- ATSA 12,12 (default) "subdirectory: "*S22
- ATSA 14,12 (default) "The script BBSETUP must be used to identify the subdir-"
- ATSA 15,12 (default) "ectory used by this BBS, and to create and maintain the"
- ATSA 16,12 (default) "files it uses."
- ATSA 17,29 (default) " Press any key to continue "
- KEYG S0
- NoUser_E:
- WCLO
- GOTO End
- Escape:
- CURS N98,N97
- WOPE 10,1 20,78 (default) ESC_ESC
- ATSA 10,3 (default) " BBS Operator menu "
- ATSA 12,3 (default) "1) Terminate the BBS"
- IF FLAG(3)
- ATSA 13,3 (default) "2) Enter chat with caller"
- ELSE
- ATSA 13,3 (default) ".. No caller currently on "
- ENDI
- ATSA 14,3 (default) "3) Cancel this window"
- ATSA 15,1 (default) "├────────────────────────────────────────────────────────────────────────────┤"
- IF ISSCRIPT "BBMAINT" and NOT FLAG(3)
- ATSA 16,3 (default) "4) Invoke BBS maintenance scripts"
- ELSE
- ATSA 16,3 (default) ".. Maintenance script not available"
- ENDI
- IF ISSCRIPT "BBSETUP" and NOT FLAG(3)
- ATSA 17,3 (default) "5) Invoke BBS setup script"
- ELSE
- ATSA 17,3 (default) ".. Setup script not available"
- ENDI
- ATSA 18,1 (default) "├────────────────────────────────────────────────────────────────────────────┤"
- ATSA 19,3 (default) "Select item: "
- ATSA 20,31 (default) " Press ESC to cancel "
- LOCA 19,16
- KEYG S0
- WCLO
- LOCA N98,N97
- SWIT S0
- CASE "1"
- GOTO End
- ENDC
- CASE "2"
- IF FLAG(3) GOTO Chat
- ENDC
- CASE "3"
- RETU
- ENDC
- CASE "4"
- GOSU EndBBS
- IF ISFILE "BBMaint" EXECUTE "BBMaint"
- ENDC
- CASE "5"
- GOSU EndBBS
- IF ISFILE "BBSetup" EXECUTE "BBSetup"
- ENDC
- DEFA
- SOUN 100,100
- ENDC
- ENDS
- GOTO Escape
- ESC_ESC:
- S0="3"
- RETU
- End:
- GOSU EndBBS
- EXIT
- EndBBS:
- SET TTHR OFF
- WOPE 10,1 12,78 (default)
- ATSA 11,3 (default) "Terminating BBS.. "
- HANG
- S9="* BBS script terminated"
- CLOG S9
- GOSU Log_Item
- SET DLDI S28
- CHDI S29
- MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J"
- TRAN "_MINIT"
- DELE "\HOSTTEMP.TXT"
- RESE
- WCLO
- CLEA
- IF ISSC "$$$SCHED" EXECUTE "$$$SCHED"
- RETU
- Chat:
- TRAN "^M^J"
- TRAN "^M^JOperator initiated chat mode..."
- S2="_LEGEND"
- LEGE "Scripted BBS (1.3); Chat mode; null entry at prompt to exit"
- Chat_Loo:
- MESS "^M^JSYSOP: "
- GET S0 80
- IF NULL S0
- MESS "Continue? (Y/N, cr=y): "
- GET S0 2
- IF FIND S0 "N"
- TRAN "^M^JChat terminated by SYSOP"
- LEGE S2
- RETU
- ENDI
- S0=" "
- ENDI
- TRAN "^M^JSYSOP: "
- TRAN S0
- MESS "Caller: "
- TRAN "^M^JCaller: "
- GOSU Read_Com
- IF FLAG(0)
- MESS "^M^JCaller disconnected"
- LEGE S2
- RETU
- ENDI
- GOTO Chat_Loo
- Limit_Ti:
- IF FLAG(1)
- SET FLAG(0) OFF
- RETU
- ENDI
- TIME S9 1
- N19=S9(0:1)*60+S9(3:4)
- N18=S6(0:1)*60+S6(3:4)
- IF GT N18 N19
- N19=N19+1440
- ENDI
- N19=N19-N18
- IF GT N19 N0
- TRAN "^M^JYour alotted time has expired..."
- TRAN "^M^JYou are being disconnected."
- SET FLAG(0) ON
- RETU
- ENDI
- SET FLAG(0) OFF
- RETU
- Read_Com:
- IF FLAG(3)
- GOSU Limit_Ti
- IF FLAG(0) RETURN
- ENDI
- S9=""
- N27=0
- SET RMOD BINA
- RCOM100:
- SET TIME
- WHIL NOT RECEIVE and NOT HITKEY
- IF NOT CONNECTED GOTO RCOM500
- TSIN N28,N29,N30
- IF NOT ZERO N28 or N29 GT 3 GOTO RCOM400
- ENDW
- IF RECEIVE
- RGET S27 1 180
- IF FIND S27 "^M" GOTO RCOM300
- GOTO RCOM200
- ENDI
- IF HITKEY
- KEYG S27
- IF FIND S27(0:1) "0d"
- TRAN "!"
- GOTO RCOM300
- ENDI
- IF FIND S27(0:1) "08"
- ITOC 8 S27
- S27(1:79)=""
- ENDI
- LENG S27 N28
- IF N28 GT 1
- SOUN 100,400
- GOTO RCOM100
- ENDI
- IF NOT (FIND S27 "^H" and N27 EQ 0) TRANS S27
- CURS N28 N29
- ATSA N28 N29 (text) S27
- IF FIND S27 "^H"
- IF N27 GT 0 DEC N29
- ELSE
- INC N29
- ENDI
- LOCA N28 N29
- ENDI
- RCOM200:
- IF FIND S27(0:0) "^H"
- IF ZERO N27 GOTO RCOM100
- DEC N27
- IF N27 GT 0
- S9=S9(0:N27-1)
- ELSE
- S9=""
- ENDI
- GOTO RCOM100
- ENDI
- S9=S9*S27
- INC N27
- IF N27 LT 80 GOTO RCOM100
- RCOM300:
- FIND S9 "NO CARRIER"
- IF FOUND GOTO RCOM500
- SET RMOD ASCI
- SET FLAG(0) OFF
- RETU
- RCOM400:
- TRAN "^M^J... autodisconnect due to timeout^M^J"
- MESS "^M^J... autodisconnect due to timeout"
- GOTO RComm_Ex
- RCOM500:
- MESS "^M^JCaller disconnected"
- RComm_Ex:
- SET RMOD ASCI
- SET FLAG(0) ON
- RETU
- Display_:
- IF FLAG(1) RETURN
- TIME S9 1
- N19=S9(0:1)*60+S9(3:4)
- N18=S6(0:1)*60+S6(3:4)
- IF GT N18 N19
- N19=N19+1440
- ENDI
- N19=N0-(N19-N18)
- STRF S9 "^M^J(%d minutes remaining)" N19
- TRAN S9
- RETU
- Logon:
- FOPENI "BBS-User" TEXT
- IF FAILED
- SET FLAG(0) ON
- RETU
- ENDI
- Logon_Lo:
- READ S9 80 N19
- IF EOF
- FCLOSEI
- SET FLAG(0) ON
- RETU
- ENDI
- FIND S9(0:0) "<"
- IF FOUND GOTO Logon_Loop
- SWIT S1
- CASE S9(0:15)
- GOTO Logon_OK
- ENDC
- ENDS
- GOTO Logon_Lo
- Logon_OK:
- SET FLAG(1) OFF
- SET FLAG(3) ON
- N0=60
- FIND S9(16:16) "P"
- IF FOUND
- SET FLAG(1) ON
- N0=3000
- ENDI
- TIME S6 1
- FCLOSEI
- SET FLAG(0) OFF
- RETU
- Disp_Fil:
- IF ISFILE S8
- TRAN "^M^J"
- SEND ASCII S8
- RETU
- ENDI
- IF ISFILE S22&"\"*S8
- TRAN "^M^J"
- SEND ASCII S22&"\"*S8
- RETU
- ENDI
- TRAN S9
- RETU
- Log_Item:
- FOPENO S22&"\BBS-LOG" TEXT APPEND
- IF FAILED RETURN
- DATE S7
- CONC S9(59) S7
- TIME S7 1
- CONC S9(70) S7
- WRIT S9
- WRIT "^M"
- FCLOSEO
- RETU
- Copy_Tex:
- N20=0
- Copy_Loo:
- INC N20
- S9=N20&": ^H"
- TRAN S9
- GOSU Read_Com
- IF FLAG(0) RETURN
- LENG S9 N18
- IF NOT ZERO N18
- PRES S9
- WRIT S9
- IF FAILED
- TRAN "Error recording text - please try later^M^J"
- RETU
- ENDI
- WRIT "!"
- GOTO Copy_Loo
- ELSE
- TRAN "^M^JComplete? (Y/N, cr=n): "
- GOSU Read_Com
- IF FLAG(0) RETURN
- IF NOT FIND S9 "Y"
- WRIT "!"
- GOTO Copy_Loo
- ENDI
- ENDI
- RETU
- Restart:
- CHDI S22
- SET RECH OFF
- SET RDIS OFF
- CLEA
- LOCA 0,0
- SET FLAG(1) OFF
- SET FLAG(2) OFF
- SET FLAG(3) OFF
- IF NOT ISSC "$$$SCHED"
- HANG
- MESS "^M^JWaiting..."
- PAUS 3
- ENDI
- SET BAUD S20(5:8)
- TRAN S21
- Wait_Con:
- RGET S9 80 180
- IF FAILED GOTO Wait_Connect
- FIND S9 "NO CARRIER"
- IF FOUND GOTO Exit
- FIND S9 "CONNECT"
- IF NOT FOUND GOTO Wait_Connect
- GOSU AutoBaud
- PAUS 3
- RFLU
- SET RECH ON
- SET RDIS ON
- PAUS 1
- S9="^M^JThe Flying Scotsman greets you!! ^M^J"
- S8="BBS-Welc"
- GOSU Disp_Fil
- N10=0
- ID_Query:
- MESS "^M^JID prompt: "
- TRAN "^M^JEnter your ID (or enter GUEST): "
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- IF NULL S9
- INC N10
- IF GE N10 3 GOTO Logon_Fail
- GOTO ID_Query
- ENDI
- SWIT S9
- CASE "GUEST"
- GOSU Register
- GOTO Exit
- ENDC
- ENDS
- S1=S9(0:7)
- UPPE S1
- Password:
- TRAN "^M^JEnter your password: "
- SET RECH OFF
- SET RDIS OFF
- GOSU Read_Com
- SET RECH ON
- IF FLAG(0) GOTO Exit
- SET RDIS ON
- IF NULL S9
- INC N10
- IF GE N10 3 GOTO Logon_Fail
- GOTO Password
- ENDI
- S1(8:79)=S9(0:7)
- GOSU Logon
- IF NOT FLAG(0)
- S9="Logon: "*S1(0:7)
- GOSU Log_Item
- SET FLAG(2) OFF
- S1=S1(0:7)
- CLOG "* BBS logon: "*S1
- TRAN "^M^J"
- GOTO Main_Pro
- ENDI
- Logon_Fa:
- TRAN "Unrecognized ID/Password^M^J"
- INC N10
- IF GE N10 3
- TRAN "You have exceeded the number of tries allowed for logon^M^JBye...^M^J"
- MESS "^M^JLogon attempts failed^M^J"
- S9="Failed logon"
- GOSU Log_Item
- GOTO Exit
- ENDI
- GOTO ID_Query
- Main_Pro:
- MESS "^M^JMain prompt: "
- GOSU Display_
- IF NOT FLAG(1)
- S9="^M^JC)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
- S8="BBS-NpMn"
- ELSE
- S9="^M^JP)rivileged, C)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
- S8="BBS-PrMn"
- ENDI
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- SWIT S9
- CASE "A"
- GOTO Alarm
- ENDC
- CASE "M"
- GOTO Mail_Com
- ENDC
- CASE "F"
- GOTO File_Com
- ENDC
- CASE "C"
- GOTO Comment
- ENDC
- CASE "B"
- GOTO Bull_Com
- ENDC
- CASE "E"
- GOTO Logoff
- ENDC
- CASE "P"
- IF FLAG(1) GOTO Priv_Prompt
- ENDC
- ENDS
- TRAN "^M^JCommand not recognized... try again^M^J"
- GOTO Main_Pro
- Logoff:
- CHDI S22
- TRAN "^M^JOK... Bye^M^J"
- S9="Logoff: "*S1(0:7)
- CLOG S9
- GOSU Log_Item
- Exit:
- S9="* BBS cycled"
- CLOG S9
- GOSU Log_Item
- MESS "^G"
- IF ISSC "$$$SCHED" GOTO End
- GOTO Restart
- Alarm:
- SOUN 440 500
- SOUN 493 100
- SOUN 554 100
- SOUN 587 100
- SOUN 659 100
- SOUN 739 100
- SOUN 830 100
- SOUN 880 500
- GOTO Main_Pro
- Priv_Pro:
- MESS "^M^JPrivilege prompt: "
- GOSU Display_
- IF NULL S26
- S9="^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
- ELSE
- S9="^M^JL)ist, P)ath, S)ubdir, doorW)ay, D)OS, M)ain or E)xit: "
- ENDI
- S8="BBS-PPMn"
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- SWIT S9
- CASE "L"
- GOTO DIR
- ENDC
- CASE "S"
- GOTO CHDIR
- ENDC
- CASE "P"
- GOTO PATHLIST
- ENDC
- CASE "D"
- GOTO Shell
- ENDC
- CASE "W"
- GOTO DropDOS
- ENDC
- CASE "M"
- GOTO Main_Pro
- ENDC
- CASE "E"
- GOTO Logoff
- ENDC
- ENDS
- TRAN "^M^JCommand not recognized... try again^M^J"
- GOTO Priv_Pro
- CHDIR:
- MESS "^M^JCHDIR Command: "
- TRAN "^M^JEnter the drive:subdirectory: "
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- IF NOT NULL S9
- CHDI S9
- SET FLAG(2) ON
- ENDI
- GOTO Priv_Pro
- PATHLIST:
- MESS "^M^JPathlist command: "
- TRAN "^M^JWorking..."
- DOS "TREED >\HOSTTEMP.TXT"
- TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
- SEND ASCII "\HOSTTEMP.TXT"
- TRAN "^M^J"
- DELE "\HOSTTEMP.TXT"
- GOTO Priv_Pro
- Shell:
- MESS "^M^JDOS Command: "
- TRAN "^M^JWarning: this command may be used to invoke ANY COMMAND that"
- TRAN "^M^JDOS can execute. If you load a program requiring keyboard "
- TRAN "^M^Jentry, you lock yourself out and leave the board unusable."
- TRAN "^M^J"
- TRAN "^M^JEnter your command: "
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- IF NULL S9
- GOTO Priv_Pro
- ENDI
- IF FIND S9 "FORMAT"
- TRAN "^M^JFormat commands are not allowed..."
- GOTO Priv_Pro
- ENDI
- TRAN "^M^JWorking..."
- CONC S9 ">\HOSTTEMP.TXT"
- DOS S9
- TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
- SEND ASCII "\HOSTTEMP.TXT"
- TRAN "^M^J"
- DELE "\HOSTTEMP.TXT"
- GOTO Priv_Pro
- Dir:
- MESS "^M^JDirectory command: "
- TRAN "^M^JWorking..."
- DOS "DIR >\HOSTTEMP.TXT"
- TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
- SEND ASCII "\HOSTTEMP.TXT"
- TRAN "^M^J"
- DELE "\HOSTTEMP.TXT"
- GOTO Priv_Pro
- DROPDOS:
- IF NULL S26
- TRAN "^M^JCommand not recognized... try again"
- GOTO Priv_Pro
- ENDI
- FOPENO "HOSTTEMP.BAT" TEXT
- IF NOT SUCCESS
- TRAN "File error - cannot drop to DOS^M^J"
- GOTO Priv_Pro
- ENDI
- WRIT "ECHO OFF!"
- S0=S26
- PRES S0
- WRIT S0
- WRIT "!"
- WRIT S29(0:1)*"!"
- IF NOT NULL S29(2:79) WRITE "CD "*S29(2:79)&"!"
- WRIT "COM-AND /q/p/f"
- WRIT "_SCRIPT"&"!"
- WRIT "^Z"
- FCLOSEO
- S0="OFFOFFOFF"
- IF FLAG(1) S0(0:2)="ON"
- IF FLAG(2) S0(3:5)="ON"
- IF FLAG(3) S0(6:8)="ON"
- STOR STRING "HOSTTEMP.STR"
- CLOG "* Drop-to-DOS"
- SET TTHR OFF
- STAC CLEAR
- STAC "HOSTTEMP.BAT!"
- BYE
- File_Com:
- MESS "^M^JFile prompt: "
- SUBD S19
- CHDI S23
- File_Pro:
- GOSU Display_
- S9="^M^JL)ist, S)earch, U)pload, D)ownload, M)ain or E)xit: "
- S8="BBS-FiMe"
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- SWIT S9
- CASE "D"
- GOTO DOWNLOAD
- ENDC
- CASE "U"
- GOTO UPLOAD
- ENDC
- CASE "L"
- GOTO FILELIST
- ENDC
- CASE "S"
- GOTO Search
- ENDC
- CASE "M"
- CHDI S19
- GOTO Main_Pro
- ENDC
- CASE "E"
- GOTO Logoff
- ENDC
- ENDS
- TRAN "Invalid selection - try again^M^J"
- GOTO FILE_Pro
- File_Que:
- MESS "^M^JFname query: "
- TRAN "^M^JEnter the file name: "
- GOSU Read_Com
- RETU
- UPLOAD:
- MESS "^M^JUpload from caller "
- GOSU File_Que
- IF FLAG(0) GOTO Exit
- IF NULL S9
- GOTO File_Pro
- ENDI
- IF FIND S9 "\" and NOT FLAG(1)
- TRAN "^M^JQualified file names are not permitted."
- GOTO UPLOAD
- ENDI
- IF ISDLFILE S9
- TRAN "^M^JFile already exists"
- GOTO UPLOAD
- ENDI
- MESS "^M^JUlo Method prompt: "
- TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, or K)ermit: "
- S8=S9
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- TIME S10 1
- SWIT S9
- CASE "W"
- TRAN "^M^JBegin your transfer procedure..."
- GETF WXMODEM S8
- ENDC
- CASE "X"
- TRAN "^M^JBegin your transfer procedure..."
- GETF XMODEM S8
- ENDC
- CASE "Y"
- TRAN "^M^JBegin your transfer procedure..."
- GETF YMODEM S8
- ENDC
- CASE "Z"
- TRAN "^M^JBegin your transfer procedure..."
- GETF ZMODEM
- ENDC
- CASE "K"
- TRAN "^M^JBegin your transfer procedure..."
- GETF KERMIT
- ENDC
- DEFA
- TRAN "^M^JInvalid transfer selection"
- SET SUCC OFF
- GOTO EOTransf
- ENDC
- ENDS
- IF FAILED
- S9="Upload ("*S9(0:0)*"): "*S8&", Failure"
- GOSU Log_Item
- DELE S8
- SET SUCC OFF
- GOTO EOTransf
- ELSE
- S9="Upload ("*S9(0:0)*"): "*S8&", Success"
- GOSU Log_Item
- ENDI
- IF FIND S8 "\"
- GOTO File_Pro
- ENDI
- TIME S11 1
- N19=S11(0:1)*60+S11(3:4)
- N18=S10(0:1)*60+S10(3:4)
- IF GT N18 N19
- N19=N19+1440
- ENDI
- N0=N0+(N19-N18)
- Describe:
- TRAN "^M^JDescription: "
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- IF NULL S9
- TRAN "^M^JPlease leave something of a description"
- GOTO Describe
- ENDI
- FOPENO "BBS-File" TEXT APPEND
- IF FAILED
- S9="Uload of "*S8&" succeeded, but BBS-FIle open failed"
- GOSU Log_Item
- SET SUCC OFF
- GOTO EOTransf
- ENDI
- DATE S0
- S8=S8&" "
- FSIZ S11 S8
- S10=S8(0:11)*S0(0:7)*" "*S11(0:6)*S9
- WRIT S10
- WRIT "!"
- FCLOSEO
- SET SUCC ON
- GOTO EOTransf
- DOWNLOAD:
- MESS "^M^JDownload to caller "
- GOSU File_Que
- IF FLAG(0) GOTO Exit
- IF NULL S9 GOTO File_Prompt
- IF FIND S9 "\"
- IF NOT FLAG(1)
- TRAN "^M^JQualified file names are not permitted."
- GOTO DOWNLOAD
- ENDI
- ENDI
- IF NOT ISFILE S9
- GOSU FileTest
- IF FAILED
- TRAN "^M^JFile doesn't exist"
- GOTO DOWNLOAD
- ENDI
- ENDI
- S8=S9
- MESS "^M^JDlo Method prompt "
- TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, K)ermit, or A)scii: "
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- SWIT S9
- CASE "A"
- TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
- SEND ASCII S8
- ENDC
- CASE "W"
- TRAN "^M^JBegin your transfer procedure..."
- SEND WXMODEM S8
- ENDC
- CASE "X"
- TRAN "^M^JBegin your transfer procedure..."
- SEND XMODEM S8
- ENDC
- CASE "Y"
- TRAN "^M^JBegin your transfer procedure..."
- SEND YMODEM S8
- ENDC
- CASE "Z"
- TRAN "^M^JBegin your transfer procedure..."
- SEND ZMODEM S8
- ENDC
- CASE "K"
- TRAN "^M^JBegin your transfer procedure..."
- SEND KERMIT S8
- ENDC
- DEFA
- TRAN "^M^JInvalid transfer selection"
- SET SUCC OFF
- GOTO EOTransf
- ENDC
- ENDS
- IF FAILED
- S9="Download ("*S9(0:0)*"): "*S8&", Failure"
- GOSU Log_Item
- SET SUCC OFF
- ELSE
- S9="Download ("*S9(0:0)*"): "*S8&", Success"
- GOSU Log_Item
- SET SUCC ON
- ENDI
- EOTransf:
- IF FAILED
- MESS "^M^JTransfer failed "
- ELSE
- MESS "^M^JTransfer OK "
- ENDI
- GOTO File_Pro
- FileTest:
- FOPENI "BBS-File" TEXT
- IF FAILED
- SET SUCC OFF
- RETU
- ENDI
- LJ S9
- FTestLoo:
- READ S0 80 N19
- IF EOF GOTO FTestEnd
- IF FIND S0(0:0) "*" GOTO FTestLoop
- IF NOT FIND S0(0:11) S9 GOTO FTestLoop
- S2=S0(0:11)
- IF FIND S0(28:28) "^A"
- IF FIND S0(29:79) "^A" N11
- S2=S0(29:29+N11-1)&"\"*S2
- ENDI
- ENDI
- IF NOT ISFILE S2 GOTO FTestLoop
- S9=S2
- FCLOSEI
- SET SUCC ON
- RETU
- FTestEnd:
- FCLOSEI
- SET SUCC OFF
- RETU
- Filelist:
- N10=0
- FOPENI "BBS-File" TEXT
- IF FAILED
- TRAN "^M^JNo files are available at this time^M^J"
- GOTO File_Pro
- ENDI
- FListLoo:
- READ S9 80 N19
- IF EOF GOTO FListEnd
- IF FIND S9(0:0) "*" GOTO FListPrint
- S0=S9(0:11)
- IF FIND S9(28:28) "^A"
- IF FIND S9(29:79) "^A" N11
- S0=S9(29:29+N11-1)&"\"*S0
- S9(28:79)=S9(29+N11+1:79)
- ENDI
- ENDI
- IF NOT ISFILE S0 GOTO FListLoop
- IF FIND S9(12:12) "*"
- FDAT S2 S0 1
- FSIZ S3 S0
- S9(12:19)=S2
- S9(21:27)=S3
- ENDI
- IF ZERO N10
- TRAN "^M^JName Dated Size Description ^M^J"
- TRAN "------------ -------- ------- ----------------------------------------------^M^J"
- ENDI
- S9=S9(0:11)*" "*S9(12:19)*" "*S9(21:27)*" "*S9(28:79)
- FListPri:
- PRES S9
- TRAN S9
- TRAN "^M^J"
- N10=N10+1
- GOTO FListLoo
- FListEnd:
- FCLOSEI
- GOTO File_Pro
- Search:
- TRAN "^M^JEnter the search string: "
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- IF NULL S9 GOTO File_Prompt
- S18=S9
- FOPENI "BBS-File" TEXT
- IF FAILED
- TRAN "^M^JNo files are available at this time^M^J"
- GOTO File_Pro
- ENDI
- N10=0
- Search_L:
- READ S9 80 N19
- IF EOF GOTO Search_End
- IF FIND S9(0:0) "*" GOTO Search_Loop
- S0=S9(0:11)
- IF FIND S9(28:28) "^A"
- IF FIND S9(29:79) "^A" N11
- S0=S9(29:29+N11-1)&"\"*S0
- S9(28:79)=S9(29+N11+1:79)
- ENDI
- ENDI
- IF NOT ISFILE S0 GOTO Search_Loop
- IF FIND S9(12:12) "*"
- FDAT S2 S0 1
- FSIZ S3 S0
- S9(12:19)=S2
- S9(21:27)=S3
- ENDI
- IF NOT FIND S9 S18 GOTO Search_Loop
- IF ZERO N10
- TRAN "^M^JName Dated Size Description ^M^J"
- TRAN "------------ -------- ------- ----------------------------------------------^M^J"
- ENDI
- S0=S9(0:11)*" "*S9(12:19)*" "*S9(21:27)*" "*S9(28:79)
- PRES S0
- TRAN S0
- TRAN "^M^J"
- N10=N10+1
- GOTO Search_L
- Search_E:
- IF ZERO N10
- TRAN "^M^JNo matches"
- ENDI
- FCLOSEI
- GOTO File_Pro
- Comment:
- SUBD S19
- CHDI S22
- MESS "^M^JComment requested "
- S9="Do you wish to leave a comment? (Y/N, cr=n): "
- S8="BBS-NoMe"
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- FIND S9 "Y"
- IF NOT FOUND
- TRAN "OK"
- CHDI S19
- GOTO Main_Pro
- ENDI
- FOPENO "BBS-Note" TEXT APPEND
- IF FAILED
- TRAN "Error recording note - please try later^M^J"
- CHDI S19
- GOTO Main_Pro
- ENDI
- S9="*** Note left by "
- CONC S9(17) S1
- DATE S8
- CONC S9(25) S8(0:9)
- TIME S8 1
- CONC S9(35) S8(0:7)
- WRIT S9
- WRIT "!"
- TRAN "Each line, as you enter it will be recorded. No edits, yet...^M^J"
- TRAN "Enter a line/line(s) of text. A blank line ends the note.^M^J"
- GOSU Copy_Tex
- WRIT "------------!"
- FCLOSEO
- IF FLAG(0) GOTO Exit
- TRAN "Your note has been recorded - thanks^M^J"
- S9="Comment recorded"
- GOSU Log_Item
- CHDI S19
- GOTO Main_Pro
- Bull_Com:
- SUBD S19
- CHDI S25
- BULL_Lis:
- MESS "^M^JBulletin list: "
- N10=0
- FOPENI "BBS-Bull" TEXT
- IF FAILED
- TRAN "^M^JNo bulletins exist^M^J"
- CHDI S19
- GOTO Main_Pro
- ENDI
- Bull_Loo:
- READ S9 80 N19
- IF EOF GOTO Bull_Prompt
- IF NOT NULL S9(13:13)
- IF NOT FLAG(1) GOTO Bull_Loop
- ENDI
- IF FIND S9(0:0) "*" GOTO Bull_Loop
- S0=S9(14:25)
- IF NOT ISFILE S0 GOTO Bull_Loop
- IF ZERO N10
- TRAN "^M^JNum Dated Subject^M^J"
- TRAN "----- -------- -------------------------------------------------------------^M^J"
- ENDI
- S0=S9(0:4)*" "*S9(5:12)*" "*S9(26:79)
- PRES S0
- TRAN S0
- TRAN "^M^J"
- N10=N10+1
- GOTO Bull_Loo
- Bull_Pro:
- FCLOSEI
- GOSU Display_
- S9="^M^JL)ist, M)ain, E)xit, or a bulletin number: "
- S8="BBS-BuMe"
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- IF FIND S9(0:0) "L"
- GOTO Bull_Lis
- ENDI
- IF FIND S9(0:0) "M"
- CHDI S19
- GOTO Main_Pro
- ENDI
- IF FIND S9(0:0) "E"
- GOTO Logoff
- ENDI
- FOPENI "BBS-Bull" TEXT
- IF FAILED
- TRAN "^M^JNo bulletins available^M^J"
- CHDI S19
- GOTO Main_Pro
- ENDI
- S0=S9
- Bull_Sca:
- READ S9 80 N19
- IF EOF
- TRAN "^M^JNo such bulletin!! ^M^J"
- FCLOSEI
- GOTO Bull_Pro
- ENDI
- IF FIND S9(0:0) "*" GOTO Bull_Scan
- IF NOT NULL S9(13:13)
- IF NOT FLAG(1) GOTO Bull_Scan
- ENDI
- S8=S9(14:25)
- IF NOT ISFILE S8 GOTO Bull_Scan
- S9=S9(0:4)
- LJ S9
- SWIT S9
- CASE S0(0:4)
- GOTO Bull_Rea
- ENDC
- ENDS
- GOTO Bull_Sca
- Bull_Rea:
- FCLOSEI
- MESS "^M^JReading bulletin: "*S8
- S9="^M^JError opening bulletin file"
- GOSU Disp_Fil
- S9="Bulletin "*S8&" read"
- GOSU Log_Item
- GOTO Bull_Pro
- Mail_Com:
- MESS "^M^JMail prompt: "
- SUBD S19
- CHDI S24
- Mail_Pro:
- GOSU Display_
- S9="^M^JS)can, L)ist, N)ew, A)ll, W)rite, M)ain or E)xit: "
- S8="BBS-MeMe"
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- SWIT S9
- CASE "N"
- GOTO Read_New
- ENDC
- CASE "A"
- GOTO Read_All
- ENDC
- CASE "W"
- GOTO Write_ms
- ENDC
- CASE "S"
- GOTO Scan_Msg
- ENDC
- CASE "L"
- GOTO List_Msg
- ENDC
- CASE "M"
- CHDI S19
- GOTO Main_Pro
- ENDC
- CASE "E"
- GOTO Logoff
- ENDC
- ENDS
- TRAN "Invalid selection - try again^M^J"
- GOTO Mail_Pro
- Scan_Msg:
- N10=0
- N11=0
- FOPENI "BBS-Mail" TEXT
- IF FAILED GOTO Scan_Rpt
- TRAN "^M^JWorking..."
- Scan_Loo:
- READ S9 80 N19
- IF EOF GOTO Scan_Rpt
- S0=S9(0:7)
- SWIT S0
- CASE S1
- S0=S9(25:37)
- IF ISFILE S0 INC N11
- ENDC
- ENDS
- INC N10
- N12=N10/10*10
- IF EQ N10 N12
- TRAN "."
- ENDI
- GOTO Scan_Loo
- Scan_Rpt:
- IF ZERO N11
- TRAN "^M^JYou have no messages waiting"
- ELSE
- STRF S0 "^M^JYou have %d message(s) waiting." N11
- TRAN S0
- ENDI
- FCLOSEI
- GOTO Mail_Pro
- List_Msg:
- N10=0
- FOPENI "BBS-Mail" TEXT
- IF FAILED
- TRAN "^M^JNo mail exists - why not write something?^M^J"
- GOTO Mail_Pro
- ENDI
- List_Loo:
- READ S9 80 N19
- IF EOF GOTO List_End
- S0=S9(0:7)
- SWIT S0
- CASE S1
- ENDC
- DEFA
- IF FIND S9(16:16) "P"
- IF NOT STRCMP S9(8:15) S1
- GOTO List_Loo
- ENDI
- ENDI
- ENDC
- ENDS
- S0=S9(25:37)
- IF NOT ISFILE S0 GOTO List_Loop
- IF ZERO N10
- TRAN "^M^JTo From Date Subject^M^J"
- TRAN "-------- -------- -------- -------------------------------------------------^M^J"
- ENDI
- S0=S9(0:7)*" "*S9(8:15)*" "*S9(17:24)*" "*S9(38:79)
- PRES S0
- TRAN S0
- TRAN "^M^J"
- N10=N10+1
- GOTO List_Loo
- List_End:
- FCLOSEI
- GOTO Mail_Pro
- Read_New:
- S7=" "
- IF NOT ISFILE S1&".NEW" GOTO Read_Msg
- FOPENI S1&".NEW" TEXT
- IF FAILED GOTO Read_Msg
- READ S7 8 N19
- FCLOSEI
- GOTO Read_Msg
- Read_All:
- S7=" "
- GOTO Read_Msg
- DateTest:
- IF NOT NUMERIC S2(0) or NOT NUMERIC S2(3) or NOT NUMERIC S2(6)
- N10=0
- RETU
- ENDI
- IF NOT NUMERIC S0(0) or NOT NUMERIC S0(3) or NOT NUMERIC S0(6)
- N10=0
- RETU
- ENDI
- IF S0(6:7) EQ S2(6:7)
- N10=(S0(0:1)*100+S0(3:4))-(S2(0:1)*100+S2(3:4))
- IF N10 LT 0
- N10=-1
- ELSE
- IF N10 GT 0
- N10=1
- ELSE
- N10=0
- ENDI
- ENDI
- RETU
- ENDI
- N10=S0(6:7)+1900
- N11=S2(6:7)+1900
- IF S0(6:7) LT 80 N10=N10+100
- IF S2(6:7) LT 80 N11=N10+100
- IF N10 LT N11
- N10=-1
- ELSE
- IF N10 GT N11
- N10=1
- ELSE
- N10=0
- ENDI
- ENDI
- RETU
- Read_Msg:
- FOPENI "BBS-Mail" TEXT
- IF FAILED
- TRAN "^M^JNo mail exists - why not write something?^M^J"
- GOTO Mail_Pro
- ENDI
- S3=" "
- Read_Loo:
- READ S9 80 N19
- IF EOF GOTO Read_End
- S2=S9(17:24)
- S0=S7
- GOSU DateTest
- IF N10 GT 0 GOTO Read_Loop
- S0=S9(0:7)
- SWIT S0
- CASE S1
- SET FLAG(9) ON
- ENDC
- DEFA
- SET FLAG(9) OFF
- IF STRCMP S9(8:15) S1 SET FLAG(9) ON
- IF FIND S9(16:16) "P" and NOT FLAG(9)
- GOTO Read_Loo
- ENDI
- ENDC
- ENDS
- S0=S9(25:37)
- IF NOT ISFILE S0 GOTO Read_Loop
- S4=S9(8:15)
- S5=S9(38:79)
- S8=S0
- S9="^M^JError opening mailfile"
- GOSU Disp_Fil
- S0=S3
- GOSU DateTest
- IF NULL S3 or N10 LT 0 S3=S2
- Read_Dis:
- IF FLAG(9)
- TRAN "^M^JD)elete, R)eply, Q)uit (cr=continue): "
- ELSE
- TRAN "^M^JR)eply, Q)uit (cr=continue): "
- ENDI
- GOSU Read_Com
- IF FLAG(0) GOTO Exit
- LJ S9
- S9=S9(0:0)
- IF NULL S9 S9="c"
- SWIT S9
- CASE "D"
- IF FLAG(9)
- DELE S8
- TRAN "Message deleted^M^J"
- ELSE
- TRAN "You may not delete this note^M^J"
- ENDI
- ENDC
- CASE "R"
- S10=S4
- S11=S5
- IF NOT STRCMP S5(0:9) "Reply to: " S11="Reply to: "*S5
- GOSU Reply
- IF FLAG(0) GOTO Exit
- ENDC
- CASE "C"
- GOTO Read_Loo
- ENDC
- CASE "Q"
- GOTO Read_End
- ENDC
- DEFA
- TRAN "^M^JUnrecognized command - please try again^M^J"
- ENDC
- ENDS
- GOTO Read_Dis
- Read_End:
- FCLOSEI
- IF NOT NULL S3
- FOPENO S1&".NEW" TEXT
- IF FAILED GOTO Mail_Prompt
- WRIT S3*"!"
- FCLOSEO
- ENDI
- GOTO Mail_Pro
- Write_Ms:
- GOSU Compose
- IF FLAG(0) GOTO Exit
- GOTO Mail_Pro
- Compose:
- TRAN "To: ^H"
- GOSU Read_Com
- IF FLAG(0) RETURN
- LJ S9
- IF NULL S9 RETURN
- S10=S9(0:7)
- UPPE S10
- TRAN "Subject: ^H"
- GOSU Read_Com
- IF FLAG(0) RETURN
- S11=S9
- PRES S11
- Reply:
- FOPENO "\HOSTTEMP.TXT" TEXT
- IF FAILED
- TRAN "Error opening file - please try later^M^J"
- RETU
- ENDI
- S9="To: "
- CONC S9(7) S10
- WRIT S9
- WRIT "!"
- S9="From: "
- CONC S9(7) S1
- WRIT S9
- WRIT "!"
- S9="Date: "
- DATE S12
- CONC S9(7) S12
- TIME S8 1
- CONC S9(17) S8
- WRIT S9
- WRIT "!"
- S9="Subject: "
- CONC S9(9) S11
- WRIT S9
- WRIT "!"
- WRIT "!"
- TRAN "Each line, as you enter it will be recorded. No edits, yet...^M^J"
- TRAN "Enter a line/line(s) of text. A blank line ends the text.^M^J"
- GOSU Copy_Tex
- FCLOSEO
- IF FLAG(0) RETURN
- TRAN "Save? (Y/N, cr=y): ^H"
- GOSU Read_Com
- IF FLAG(0) RETURN
- IF FIND S9 "N" RETURN
- TRAN "^M^JScanning for free slot"
- N10=0
- S0=S10(0:7)
- WHIL ISFILE S0&"."&N10
- INC N10
- IF N10 GT 999
- TRAN "^M^JToo many notes left undeleted - cannot save^M^J"
- RETU
- ENDI
- ENDW
- TRAN "^M^JPrivate? (Y/N, cr=n): "
- GOSU Read_Com
- IF FLAG(0) RETURN
- S13=" "
- IF FIND S9 "Y" S13="P"
- S0=S0&"."&N10
- S9="COPY \HOSTTEMP.TXT "*S0
- DOS S9
- FOPENO "BBS-Mail" TEXT APPEND
- WRIT S10 8
- WRIT S1 8
- WRIT S13 1
- WRIT S12 8
- WRIT S0 13
- WRIT S11 40
- WRIT "!"
- FCLOSEO
- RETU
- Register:
- MESS "^M^JRegistration requested "
- S9="Do you wish to register? (Y/N, cr=y): "
- S8="BBS-ReMe"
- GOSU Disp_Fil
- GOSU Read_Com
- IF FLAG(0)
- S9="Registration aborted - disconn"
- GOSU Log_Item
- RETU
- ENDI
- IF FIND S9 "N"
- S9="Registration declined by caller"
- GOSU Log_Item
- TRAN "OK - bye^M^J"
- RETU
- ENDI
- TRAN "Enter your full name: "
- GOSU Read_Com
- IF FLAG(0) RETURN
- S18=S9
- TRAN "Enter your street address: "
- GOSU Read_Com
- IF FLAG(0) RETURN
- S17=S9
- TRAN "Enter your city/state and zip: "
- GOSU Read_Com
- IF FLAG(0) RETURN
- S16=S9
- TRAN "Enter a area code and phone number where^M^J"
- TRAN "you may be reached: "
- GOSU Read_Com
- IF FLAG(0) RETURN
- S15=S9
- Reg_ID:
- TRAN "Enter the ID (1-8 chars) you wish to use: "
- GOSU Read_Com
- IF FLAG(0) RETURN
- IF FIND S9(0:7) "."
- TRAN "ID may not contain '.'s^M^J"
- GOTO Reg_ID
- ENDI
- IF FIND S9(0:7) ","
- TRAN "ID may not contain ','s^M^J"
- GOTO Reg_ID
- ENDI
- IF FIND S9(0:7) "\"
- TRAN "ID may not contain '\'s^M^J"
- GOTO Reg_ID
- ENDI
- IF FIND S9(0:7) "/"
- TRAN "ID may not contain '/'s^M^J"
- GOTO Reg_ID
- ENDI
- S14=S9(0:7)
- Reg_Pass:
- TRAN "Enter the password (1-8 chars) you wish to use: "
- GOSU Read_Com
- IF FLAG(0) RETURN
- IF NULL S9(0:7)
- TRAN "You must have a password^M^J"
- GOTO Reg_Pass
- ENDI
- S14=S14&";"&S9(0:7)
- TRAN "^M^JRepeating your entry...^M^J"
- TRAN S18
- TRAN "^M^J"
- TRAN S17
- TRAN "^M^J"
- TRAN S16
- TRAN "^M^J"
- TRAN S15
- TRAN "^M^J"
- TRAN S14
- TRAN "^M^JIs this correct? (Y/N, cr=n): "
- GOSU Read_Com
- IF FLAG(0) RETURN
- FIND S9 "Y"
- IF NOT FOUND GOTO Register
- FOPENO "BBS-Note" TEXT APPEND
- IF FAILED
- TRAN "Error recording registration - please call back^M^J"
- RETU
- ENDI
- S9="*** Registration requested: "
- DATE S1
- CONC S9(27) S1
- TIME S1 1
- CONC S9(38) S1
- WRIT S9
- WRIT "!"
- WRIT S18 80
- WRIT "!"
- WRIT S17 80
- WRIT "!"
- WRIT S16 80
- WRIT "!"
- WRIT S15 80
- WRIT "!"
- WRIT S14 80
- WRIT "!"
- WRIT "------------!"
- S9="Registration requested"
- GOSU Log_Item
- TRAN "Your request will be processed by the SYSOP^M^J"
- TRAN "Thanks for calling...^M^J"
- FCLOSEO
- RETU
- AutoBaud:
- IF FIND "_DDOVER" "ON" GOTO AUBA100
- IF FIND S9 "1200"
- SET BAUD 1200
- GOTO AUBA100
- ENDI
- IF FIND S9 "2400"
- SET BAUD 2400
- GOTO AUBA100
- ENDI
- IF FIND S9 "4800"
- SET BAUD 4800
- GOTO AUBA100
- ENDI
- IF FIND S9 "9600"
- SET BAUD 9600
- GOTO AUBA100
- ENDI
- IF FIND S9 "14400" or FIND S9 "14.4"
- SET BAUD 14k
- GOTO AUBA100
- ENDI
- IF FIND S9 "19200" or FIND S9 "19.2"
- SET BAUD 19k
- GOTO AUBA100
- ENDI
- IF FIND S9 "38400" or FIND S9 "38.4"
- SET BAUD 38k
- GOTO AUBA100
- ENDI
- IF FIND S9 "57600" or FIND S9 "57.6"
- SET BAUD 57k
- GOTO AUBA100
- ENDI
- SET BAUD 300
- AUBA100:
- GOSU Log_Item
- RETU
-