LEGE "Scripted BBS (1.1); 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"
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
FFIR S22
IF FAILURE or NOT ISFILE S22*"\BBS-User"
WCLO
GOTO NoUser
ENDI
SET BAUD S20(5:8)
SET PORT S20(0:3)
SET INAF OFF
SET ALAR OFF
SET ATIM 1
CHDI S22
SET DLDI S23
LEGE "Scripted BBS (1.1);  Press ESC to terminate or to CHAT."
TRAN "_MESCAPE"
WCLO
ON ESCA GOSU Escape
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.1);  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
EXIT
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
RESE
CLEA
MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J"
TRAN "_MINIT"
DELE "\HOSTTEMP.TXT"
WCLO
RETU
Chat:
TRAN "^M^J"
TRAN "^M^JOperator initiated chat mode..."
S2="_LEGEND"
LEGE "Scripted BBS (1.1);  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
RGET S9 80 180
IF NOT CONNECTED GOTO Disconnect
IF FAILED GOTO Timeout
FIND S9 "NO CARRIER"
IF FOUND GOTO Disconnect
SET FLAG(0) OFF
RETU
Timeout:
TRAN "^M^J... autodisconnect due to timeout^M^J"
MESS "^M^J... autodisconnect due to timeout"
GOTO RComm_Ex
Disconne:
MESS "^M^JCaller disconnected"
RComm_Ex:
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
HANG
MESS "^M^JWaiting..."
PAUS 3
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 Restart
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"
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_
S9="^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
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 "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
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:
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)
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)
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)
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
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 50
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 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 "19200"
SET BAUD 19.2
GOTO AUBA100
ENDI
IF FIND S9 "19.2"
SET BAUD 19.2
GOTO AUBA100
ENDI
SET BAUD 300
AUBA100:
GOSU Log_Item
RETU