home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Beijing Paradise BBS Backup
/
PARADISE.ISO
/
software
/
BBSDOORW
/
DND29C4.ZIP
/
SOURCE.ZIP
/
DNDSUB1.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-07
|
77KB
|
3,270 lines
Rem dndsub1.bas v2.9c
Rem $Include: 'dndbbs.inc'
Sub Open.Modem
On Local Error Goto 10015
Connect=False
Logged.In=False
Lost.Carrier=False
Max.Row=23
Show.Screen=True
Call Get.Command
10011
BBS.Name=Nul
Door.Name=Nul
If Config2(47) And Local.Mode=False Then
If Bypass.Screen=False Then
Call Opening.Screen
Call Display.Time
Show.Screen=False
Endif
Data.Error=False
Close 13
Open Door.FileName For Input Shared As #13
Temp1=False
Do Until Eof(13)
Line Input #13,Out2
Out2=Ucase$(Out2)
Temp1=Temp1+1
If Temp1=1 Then
BBS.Name=Out2
Endif
If Temp1=4 Then
If Val(Mid$(Out2,4))=False Then
Local.Mode=True
Endif
Endif
If Temp1=5 Then
Modem.Baud=Int(Val(Out2)/100)
Endif
If Temp1=7 Then
Door.Name=Out2
If Left$(Out2,5)="SYSOP" Then
Local.Mode=True
Endif
Endif
If Temp1=8 Then
If Len(Out2) Then
Door.Name=Door.Name+" "+Out2
Endif
Endif
If Temp1=12 Then
Door.Time=Val(Out2)*60!
Endif
Loop
If Len(Door.Name) Then
Max.Row=22
Endif
Connect=True
Endif
10012
If Config2(47) Then
If Local.Mode Then
If Bypass.Screen=False Then
If Show.Screen Then
Call Opening.Screen
Call Display.Time
Endif
Strng="Local DOOR"
Call Modem.Status
Endif
Call Clear.Screen
Exit Sub
Endif
If Connect=False Or Data.Error Then
Strng="DOOR file missing"
Call Error.Message
Endif
Call Driver(5)
If (Outregs.AX And &H80)=False Then
Strng="DOOR carrier lost"
Call Error.Message
Endif
Strng="DOOR connect"+Str$(Modem.Baud)+"00"
Call Modem.Status
Call Driver(4)
Call Driver(13)
Call Clear.Screen
If Config2(45)=False And Modem.Baud=3 Then
Strng="300 baud access not allowed!"
Call IO.O
Strng="300 baud access"
Call Error.Message
Endif
Exit Sub
Endif
10013
If Bypass.Screen Or Bypass.Login Then
Timeon=Timer
Time.Left=3600
Two.Minutes.Left=False
Color.Graphics=True
Local.Mode=True
Call Clear.Screen
Exit Sub
Endif
Recycle=True
Do While Recycle
Blank.Menu=True
Menu.Timer=False
Blank.Screen=False
Screen.Timer=False
Connect=False
Time.Out!=False
Call Opening.Screen
Call Recycle.Modem
Do Until Connect
If Local.Mode=False Then
Call Read.Modem
If Instr(Out2,"RING") Then
Time.Out!=Timer+Config2(60)
Out2=Nul
Strng="Ring"
Call Modem.Status
Endif
If Instr(Out2,"CONNECT 300") Then
Modem.Baud=3
Connect=True
Endif
If Instr(Out2,"CONNECT 600") Then
Modem.Baud=6
Connect=True
Endif
If Instr(Out2,"CONNECT 1200") Then
Modem.Baud=12
Connect=True
Endif
If Instr(Out2,"CONNECT 2400") Then
Modem.Baud=24
Connect=True
Endif
If Instr(Out2,"CONNECT 4800") Then
Modem.Baud=48
Connect=True
Endif
If Instr(Out2,"CONNECT 9600") Then
Modem.Baud=96
Connect=True
Endif
If Instr(Out2,"CONNECT 19200") Then
Modem.Baud=192
Connect=True
Endif
If Instr(Out2,"CONNECT 38400") Then
Modem.Baud=384
Connect=True
Endif
If Time.Out! Then
If Time.Out!<=Timer Then
If Instr(Out2,"CONNECT") Then
Modem.Baud=3
Connect=True
If Config2(45)=False Then
Strng="300 baud access not allowed!"
Call Send.Modem
Connect=False
Endif
Endif
If Connect=False Then
Strng="No Carrier"
Call Modem.Status
Connect=False
Time.Out!=False
Call Recycle.Modem
Endif
Endif
Endif
Endif
If Timer>=Time.Temp! Then
Call Display.Time
Time.Temp!=Timer+.9
If Blank.Menu=False Then
Menu.Timer=Menu.Timer+1
If Menu.Timer>=30 Then
Menu.Timer=False
Blank.Menu=True
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Call Display.Field
Selection=1
Endif
Endif
If Blank.Screen=False Then
Screen.Timer=Screen.Timer+1
If Screen.Timer>180 Then
Screen.Timer=False
If Local.Mode=False Then
Call Clear.Screen
Locate ,,0
Blank.Menu=True
Blank.Screen=True
Selection=1
Endif
Endif
Endif
Endif
TempX$=Inkey$
TempX=False
If Len(TempX$) Then
If Blank.Screen Then
If Local.Mode Then
Strng="Local Mode"
Else
Strng="Waiting For Call"
Endif
Call Modem.Status
Endif
Menu.Timer=False
Screen.Timer=False
Endif
If Len(TempX$)=1 Then
TempX$=Ucase$(TempX$)
If Instr("TLERSCDAOM",TempX$) Then
Call Menu.Select
Endif
Endif
If Len(TempX$)=2 Then
TempX=Asc(Right$(TempX$,1))
If TempX>=59 And TempX<=68 Then
Call Menu.Select
Else
If Blank.Menu=False Then
Call Menu.Select
Else
Next.Field=1
Call Show.Field
Endif
Endif
Endif
If TempX$=Chr$(27) Or TempX$="T" Then
If Blank.Menu Then
Next.Field=1
Call Show.Field
Endif
If Local.Mode=False Then
Strng=Config3(41)
Call Send.Modem
Strng="Off Hook"
Call Modem.Status
Endif
Call Clear.Screen
End
Endif
If TempX$=Chr$(13) Then
If Blank.Menu Then
Next.Field=1
Call Show.Field
Endif
If Selection<=7 Then
If Local.Mode=False Then
Strng=Config3(41)
Call Send.Modem
Strng="Off Hook"
Call Modem.Status
Endif
Endif
Select Case Selection
Case 1
Call Clear.Screen
End
Case 2
Timeon=Timer
Time.Left=3600
Color.Graphics=True
Two.Minutes.Left=False
Local.Mode=True
Lost.Carrier=False
Recycle=False
Exit Do
Case 3
Call Shell.Program("edit.exe",True,False)
Exit Do
Case 4
Call Shell.Program("dndcnfg.exe",True,False)
Exit Do
Case 5
Call Shell.Program("dndedit.exe",True,False)
Exit Do
Case 6
Call Clear.Screen
Strng="Type Exit to return.."
Call Scrn(Strng)
Shell
Exit Do
Case 7
Call Clear.Screen
Line Input "Enter DOS command: ",Var$
Close 13
Open DOS.Exit For Output Shared As #13
Print #13,Var$
Print #13,"PAUSE"
Print #13,"EXIT"
Close 13
Shell DOS.Exit
Exit Do
Case 8
Time.Out!=Timer+Config2(60)
Out2=Nul
Strng=Config3(40)
Call Send.Modem
Strng="Auto Answer"
Call Modem.Status
Case 9
Time.Out!=Timer+Config2(60)
Out2=Nul
Strng="ATO"
Call Send.Modem
Strng="Originate"
Call Modem.Status
Case 10
Connect=False
Time.Out!=False
Call Recycle.Modem
End Select
Endif
Loop
If Local.Mode=False Then
If Connect Then
Recycle=False
Strng="Connect"+Str$(Modem.Baud)+"00"
Call Modem.Status
Call Driver(4)
Call Driver(13)
Endif
Endif
10014
Loop
Call Clear.Screen
Exit Sub
10015
Data.Error=True
If Erl=10011 Then
Resume 10012
Endif
If Erl=10012 Then
Resume 10013
Endif
Resume 10014
End Sub
Sub Menu.Select
On Local Error Goto 10102
Next.Field=False
If TempX$=Chr$(9) Then
TempX=9
Endif
Var1=Instr("TLERSCDAOM",TempX$)
If Var1 Then
TempX=Var1
Endif
Select Case TempX
Case 1 To 10
Next.Field=TempX
TempX$=Chr$(13)
Case 59 To 68
Next.Field=TempX-58
TempX$=Chr$(13)
Case 72
If Selection>1 Then
Next.Field=Selection-1
Endif
Case 80
If Selection<10 Then
Next.Field=Selection+1
Endif
Case 15, 75
If Selection>5 Then
Next.Field=Selection-5
Endif
Case 9, 77
If Selection<6 Then
Next.Field=Selection+5
Endif
Case 71
If Selection<>1 Then
Next.Field=1
Endif
Case 79
If Selection<>10 Then
Next.Field=10
Endif
Case 73
If Selection<6 And Selection<>1 Then
Next.Field=1
Endif
If Selection>5 And Selection<>6 Then
Next.Field=6
Endif
Case 81
If Selection<6 And Selection<>5 Then
Next.Field=5
Endif
If Selection>5 And Selection<>10 Then
Next.Field=10
Endif
End Select
If Next.Field Then
Call Show.Field
Endif
10101
Exit Sub
10102
Resume 10101
End Sub
Sub Show.Field
On Local Error Goto 10112
Call Display.Field
Blank.Menu=False
Selection=Next.Field
Var1=Menu2(Selection,1)
Var2=Menu2(Selection,2)+3
Call Screen.ANSI(2,Var1,Var2)
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,41,79)
Strng=Left$(Menu1(Selection),1)
Call Scrn(Strng)
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,41,78)
Strng=Mid$(Menu1(Selection),2)
Strng=Rtrim$(Strng)
Call Scrn(Strng)
10111
Exit Sub
10112
Resume 10111
End Sub
Sub Display.Field
On Local Error Goto 10122
Var1=Menu2(Selection,1)
Var2=Menu2(Selection,2)+3
Call Screen.ANSI(2,Var1,Var2)
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Strng=Left$(Menu1(Selection),1)
Call Scrn(Strng)
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Strng=Mid$(Menu1(Selection),2)
Strng=Rtrim$(Strng)
Call Scrn(Strng)
10121
Exit Sub
10122
Resume 10121
End Sub
Sub Recycle.Modem
On Local Error Goto 10132
If Local.Mode Then
Strng="Local Mode"
Call Modem.Status
Exit Sub
Endif
Strng="Recycle"
Call Modem.Status
Call Drop.DTR
Modem.Baud=Config2(64)
Call Driver(4)
Call Driver(13)
Out2=Nul
Strng=Config3(42)
Call Send.Modem
Time.Temp!=Timer+2
Init=False
Do While Time.Temp!>Timer
Call Read.Modem
If Instr(Out2,"OK") Then
Init=True
Endif
Loop
Strng="Reset OK"
If Init=False Then
Strng="Reset Timeout"
Endif
Call Modem.Status
Out2=Nul
If Config2(57)<5 Then
Strng=Config3(39)
Call Send.Modem
Time.Temp!=Timer+2
Init=False
Do While Time.Temp!>Timer
Call Read.Modem
If Instr(Out2,"OK") Then
Init=True
Endif
Loop
Strng="Init OK"
If Init=False Then
Strng="Init Timeout"
Endif
Call Modem.Status
Endif
Out2=Nul
Strng="Waiting For Call"
Call Modem.Status
10131
Exit Sub
10132
Resume 10131
End Sub
Sub Send.Modem
On Local Error Goto 10142
If Local.Mode Then
Exit Sub
Endif
Call Driver(5)
Do While Outregs.AX And &H40
Call Driver(5)
Loop
Strng=Strng+Chr$(13)
For Var=1 To Len(Strng)
Inregs.AX=Asc(Mid$(Strng,Var,1))
Call Driver(7)
Next
10141
Exit Sub
10142
Resume 10141
End Sub
Sub Read.Modem
On Local Error Goto 10152
Do
Call Driver(6)
Char=Outregs.AX And &HFF
If Char=&HFF Then
Exit Do
Endif
Out2=Out2+Ucase$(Chr$(Char))
Loop
10151
Exit Sub
10152
Resume 10151
End Sub
Sub Pause.Second
On Local Error Goto 10162
Timer.Temp!=Timer+1
Do While Timer.Temp!>Timer
VarX$=Inkey$
If VarX$=Chr$(27) Then
Chat=False
Endif
If VarX$=Chr$(11) Then
If Allow.Break Then
Break=True
If Wait.Mode Or Auto.Mode Or Follow.Mode Then
Auto.Break=True
Endif
Endif
Endif
Loop
10161
Exit Sub
10162
Resume 10161
End Sub
Sub Modem.Status
On Local Error Goto 10172
If Bypass.Screen Then
Exit Sub
Endif
Out3=Strng
If Blank.Screen Then
Blank.Screen=False
Call Opening.Screen
Endif
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Call Screen.ANSI(2,23,4)
Strng=Space$(20)
Call Scrn(Strng)
Out3=Left$(Out3,20)
Temp=13-Len(Out3)/2
Call Screen.ANSI(2,23,Temp)
Strng=Out3
Call Scrn(Strng)
Call Screen.ANSI(2,23,25)
Var1=Int((Fre(TempX$)+Fre(-1)+Fre(-2))/1024)
Strng=Str$(Var1)+" KB"
Call Scrn(Strng)
Call Screen.ANSI(2,23,40)
Strng="V"+Version$
Call Scrn(Strng)
Call Display.Time
Strng=Out3
10171
Exit Sub
10172
Resume 10171
End Sub
Sub Display.Time
On Local Error Goto 10182
Call Set.Clock
If Blank.Screen=False Then
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Call Screen.ANSI(2,23,56)
Strng=FormatD$(Now#,"mmm\. d")
Call Scrn(Strng)
Call Screen.ANSI(2,23,69)
Strng=Time$
Call Scrn(Strng)
Endif
10181
Exit Sub
10182
Resume 10181
End Sub
Sub Error.Message
On Local Error Goto 10192
Max.Row=24
Call Clear.Screen
Call Scrn(Strng)
10191
End
10192
Resume 10191
End Sub
Sub Clear.Screen
On Local Error Goto 10202
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,40,15)
Call Screen.ANSI(3,0,0)
Call Screen.ANSI(2,24,1)
Call Screen.ANSI(1,37,7)
Locate Max.Row+1,1,1
10201
Exit Sub
10202
Resume 10201
End Sub
Sub Opening.Screen
On Local Error Goto 10212
Selection=1
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Call Screen.ANSI(3,0,0)
Call Screen.ANSI(2,24,1)
Locate 24,1,0
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Call Screen.ANSI(2,2,3)
Strng=Chr$(214)
Call Scrn(Strng)
Strng=String$(74,196)
Call Scrn(Strng)
Strng=Chr$(183)
Call Scrn(Strng)
Temp1=1
For Temp5=3 To 24
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Call Screen.ANSI(2,Temp5,3)
Strng=Chr$(186)
Call Scrn(Strng)
If Temp5=5 Then
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Call Screen.ANSI(2,5,23)
Strng="Dungeons And Dragons Bulletin Board"
Call Scrn(Strng)
Endif
If Temp5=7 Then
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Out2="Adventure System (Node: "
If Node=False Then
If Local.Mode Then
Out2=Out2+"Local"
Else
Out2=Out2+"BBS"
Endif
Else
Out2=Out2+Chr$(Node)
Endif
Out2=Out2+")"
Temp2=Int(40-Len(Out2)/2+1)
Call Screen.ANSI(2,7,Temp2)
Call Scrn(Out2)
Endif
If Temp1<6 Then
If Temp5=Menu2(Temp1,1) Then
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Var1=Menu2(Temp1,1)
Var2=Menu2(Temp1,2)
Call Screen.ANSI(2,Var1,Var2)
Strng="F"+Mid$(Str$(Temp1),2)+" "
Call Scrn(Strng)
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Strng=Left$(Menu1(Temp1),1)
Call Scrn(Strng)
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Strng=Mid$(Menu1(Temp1),2)
Strng=Rtrim$(Strng)
Call Scrn(Strng)
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Var1=Menu2(Temp1+5,1)
Var2=Menu2(Temp1+5,2)
Call Screen.ANSI(2,Var1,Var2)
Strng="F"+Right$(Str$(Temp1+5),1)+" "
Call Scrn(Strng)
Call Screen.ANSI(4,37,0)
Call Screen.ANSI(4,44,31)
Strng=Left$(Menu1(Temp1+5),1)
Call Scrn(Strng)
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Strng=Mid$(Menu1(Temp1+5),2)
Strng=Rtrim$(Strng)
Call Scrn(Strng)
Temp1=Temp1+1
Endif
Endif
If Temp5=22 Then
Call Screen.ANSI(4,36,0)
Call Screen.ANSI(4,44,27)
Call Screen.ANSI(2,22,10)
Strng="Status"
Call Scrn(Strng)
Call Screen.ANSI(2,22,26)
Strng="Memory"
Call Scrn(Strng)
Call Screen.ANSI(2,22,40)
Strng="Version"
Call Scrn(Strng)
Call Screen.ANSI(2,22,57)
Strng="Date"
Call Scrn(Strng)
Call Screen.ANSI(2,22,71)
Strng="Time"
Call Scrn(Strng)
Endif
Call Screen.ANSI(4,33,0)
Call Screen.ANSI(4,44,30)
Call Screen.ANSI(2,Temp5,78)
Strng=Chr$(186)
Call Scrn(Strng)
Next
Call Screen.ANSI(2,24,3)
Strng=Chr$(211)
Call Scrn(Strng)
Strng=String$(74,196)
Call Scrn(Strng)
Strng=Chr$(189)
Call Scrn(Strng)
10211
Exit Sub
10212
Resume 10211
End Sub
Sub Read.Config
On Local Error Goto 10222
Call Get.Config
Call Get.Environment
Call Make.FileNames
Call Free.Files
Call Open.Files
Call Read.Data
Call Update.Mess(True)
10221
Exit Sub
10222
Resume 10221
End Sub
Sub Get.Config
On Local Error Goto 10232
If Max.Row=False Then
Max.Row=23
Endif
Call Screen.ANSI(4,37,15)
Locate Max.Row+1,1,1
Strng="Loading.."+Chr$(13)+Chr$(10)
Call Scrn(Strng)
DND.Path=Environ$("DNDBBS")
If DND.Path<>Nul Then
If Right$(DND.Path,1)<>"\" Then
DND.Path=DND.Path+"\"
Endif
Endif
FileName=DND.Path+"DNDBBS"
If Node Then
FileName=FileName+Chr$(Node)
Endif
Data.Error=False
FileName=FileName+".CFG"
Close 13
Open FileName For Input Shared As #13
For Temp1=1 To 10
For Temp2=1 To 4
Input #13,Training.Room(Temp1,Temp2)
Next
Next
For Temp2=1 To 10
Line Input #13,Room.Array(Temp2)
Next
For Temp2=1 To 30
Input #13,Config1(Temp2)
Next
For Temp2=1 To 85
Input #13,Config2(Temp2)
Next
For Temp2=1 To 77
Line Input #13,Config3(Temp2)
Next
For Temp2=1 To 10
Line Input #13,High.Class.Name(Temp2)
Next
For Temp2=1 To 8
Line Input #13,Race(Temp2)
Next
For Temp2=1 To 10
Line Input #13,Class.Name(Temp2)
Next
For Temp2=1 To 7
Line Input #13,Stat(Temp2)
Next
For Temp2=1 To 11
Line Input #13,Direction(Temp2)
Next
For Temp2=1 To 10
Line Input #13,Numeral(Temp2)
Next
For Temp2=1 To 4
Line Input #13,Weapon.Type.Name(Temp2)
Next
For Temp2=1 To 3
Line Input #13,Alignment.Name1(Temp2)
Next
For Temp2=1 To 3
Line Input #13,Alignment.Name2(Temp2)
Next
For Temp2=1 To 70
Line Input #13,Strip.Data(Temp2)
Next
Redim Command.Set1(1 To 83, 1 To 5) As String*12,_
Command.Set2(1 To 83, 1 To 5) As String*12
For Temp2=1 To 83
For Temp3=1 To 5
Line Input #13,Command.Set1(Temp2, Temp3)
Next
Next
For Temp2=1 To 83
For Temp3=1 To 5
Line Input #13,Command.Set2(Temp2, Temp3)
Next
Next
Redim Sysop.Commands1(1 To 9) As String*10,_
Sysop.Commands2(1 To 9) As String*10
For Temp2=1 To 9
Line Input #13,Sysop.Commands1(Temp2)
Next
For Temp2=1 To 9
Line Input #13,Sysop.Commands2(Temp2)
Next
For Temp2=1 To 10
Line Input #13,Menu1(Temp2)
Input #13,Menu2(Temp2,1)
Input #13,Menu2(Temp2,2)
Next
For Temp2=11 To 16
Room.Array(Temp2)=Config3(Temp2+11)
Next
If Not Eof(13) Then
Error 99
Endif
10231
If Data.Error Then
Strng=FileName+" not found. Run DNDCNFG."
Call Error.Message
Endif
Exit Sub
10232
Data.Error=True
Resume 10231
End Sub
Sub Get.Environment
On Local Error Goto 10242
Out2=Environ$("DNDDAT")
If Out2<>Nul Then
Config3(11)=Out2
If Right$(Config3(11),1)<>"\" Then
Config3(11)=Config3(11)+"\"
Endif
Endif
Out2=Environ$("DNDDOC")
If Out2<>Nul Then
Config3(52)=Out2
If Right$(Config3(52),1)<>"\" Then
Config3(52)=Config3(52)+"\"
Endif
Endif
Out2=Environ$("DNDTEMP")
If Out2<>Nul Then
Config3(53)=Out2
If Right$(Config3(53),1)<>"\" Then
Config3(53)=Config3(53)+"\"
Endif
Endif
Out2=Environ$("DNDDOOR")
If Out2<>Nul Then
Config3(38)=Out2
If Right$(Config3(38),1)<>"\" Then
Config3(38)=Config3(38)+"\"
Endif
Endif
10241
Exit Sub
10242
Resume 10241
End Sub
Sub Make.FileNames
On Local Error Goto 10252
Door.FileName=Config3(38)+"DORINFO"
If Node Then
Door.FileName=Door.FileName+Chr$(Node)
Endif
Door.FileName=Door.FileName+".DEF"
Temp.FileName=Config3(53)+Config3(75)
If Node Then
Temp.FileName=Temp.FileName+Chr$(Node)
Endif
Temp.FileName=Temp.FileName+Config3(15)
DOS.Exit=DND.Path+Config3(70)
If Node Then
DOS.Exit=DOS.Exit+Chr$(Node)
Endif
DOS.Exit=DOS.Exit+".BAT"
Catalog.FileName=Config3(52)+Config3(65)+Config3(62)
Hint.FileName=Config3(52)+Config3(64)+Config3(62)
Summary.FileName=Config3(52)+Config3(50)+Config3(62)
Day.File.FileName=Config3(11)+Config3(72)
Day.Log.FileName=Config3(11)+Config3(67)
DMhelp.Filename=Config3(11)+Config3(63)+Config3(15)
Help.Filename=Config3(11)+Config3(56)+Config3(15)
LastUser.FileName=Config3(11)+Config3(49)+Config3(15)
Log.FileName=Config3(11)+Config3(73)+Config3(15)
Logoff.FileName=Config3(11)+Config3(28)+Config3(15)
Logon.Help.FileName=Config3(11)+Config3(61)+Config3(15)
Notice.FileName=Config3(11)+Config3(4)+Config3(15)
Prelog.FileName=Config3(11)+Config3(1)+Config3(15)
Welcome.FileName=Config3(11)+Config3(3)+Config3(15)
10251
Exit Sub
10252
Resume 10251
End Sub
Sub Free.Files
On Local Error Goto 10264
10261
Close
Temp=False
Do
Temp=Temp+1
Open Temp.FileName For Random Shared As Temp
Loop
10262
Close
Kill Temp.FileName
10263
If Temp<16 Then
Strng="Increase FILES= statement in CONFIG.SYS then reboot."
Call Error.Message
Endif
Exit Sub
10264
If Erl=10261 Then
Resume 10262
Endif
Resume 10263
End Sub
Sub Open.Files
On Local Error Goto 10272
Close
FileName=Config3(53)+Config3(69)+Config3(15)
Open FileName For Random Shared As #1 Len=Len(MessWorkRecord1)
FileName=Config3(53)+Config3(68)+Config3(15)
Open FileName For Random Shared As #2 Len=Len(MessWorkRecord2)
FileName=Config3(11)+Config3(21)+Config3(15)
Open FileName For Random Shared As #3 Len=Len(UserRecord)
FileName=Config3(11)+Config3(22)+Config3(15)
Open FileName For Random Shared As #4 Len=Len(MonsterRecord)
FileName=Config3(11)+Config3(16)+Config3(15)
Open FileName For Random Shared As #5 Len=Len(RoomRecord)
FileName=Config3(11)+Config3(17)+Config3(15)
Open FileName For Random Shared As #6 Len=Len(ObjectRecord)
FileName=Config3(11)+Config3(18)+Config3(15)
Open FileName For Random Shared As #7 Len=Len(MonsterRecord)
FileName=Config3(11)+Config3(19)+Config3(15)
Open FileName For Random Shared As #8 Len=Len(TreasureRecord)
FileName=Config3(11)+Config3(13)+Config3(15)
Open FileName For Random Shared As #9 Len=Len(MonsterTalkRecord)
FileName=Config3(54)+Config3(59)+Config3(15)
Open FileName For Random Shared As #10 Len=Len(MessageBaseRecord)
FileName=Config3(11)+Config3(12)+Config3(15)
Open FileName For Random Shared As #11 Len=Len(MonclassRecord)
FileName=Config3(11)+Config3(20)+Config3(15)
Open FileName For Random Shared As #12 Len=Len(SpellRecord)
10271
Exit Sub
10272
Resume 10271
End Sub
Sub Read.Data
On Local Error Goto 10282
Nonplyrs.Max=Lof(4)/Len(MonsterRecord)
If Nonplyrs.Max>False Then
Redim NonplyrsArray(1 To Nonplyrs.Max) As String*30
For Temp=1 To Nonplyrs.Max
Get 4,Temp,MonsterRecord
NonplyrsArray(Temp)=MonsterRecord.PluralName
Next
Endif
Users.Max=Lof(3)/Len(UserRecord)
If Users.Max=False Then
Users.Max=1
Put 3,1,UserRecord
Endif
Redim User.Array1(1 To Users.Max) As Integer,_
User.Array2(1 To Users.Max) As Integer,_
User.Array3(1 To Users.Max) As Integer
For Temp=1 To Users.Max
Get 3,Temp,UserRecord
User.Array1(Temp)=UserRecord.Room
User.Array2(Temp)=UserRecord.Level
User.Array3(Temp)=UserRecord.ClassType
Next
Monclass.Max=Lof(11)/Len(MonclassRecord)
If Monclass.Max=False Then
Monclass.Max=1
Put 11,1,MonclassRecord
Endif
Redim Monster.Class(1 To Monclass.Max,1 To 10) As Integer,_
Monster.Rate(1 To Monclass.Max,1 To 10) As Integer,_
Monster.Percent(1 To Monclass.Max,1 To 10) As Integer
For Temp=1 To Monclass.Max
Get 11,Temp,MonclassRecord
For Temp2=1 To 10
Monster.Class(Temp,Temp2)=MonclassRecord.Monsters(Temp2)
Next
Next
For TempA=1 To Monclass.Max
For Temp=1 To 10
Temp5=Monster.Class(TempA,Temp)
If Temp5>False And Temp5<=Lof(7)/Len(MonsterRecord) Then
Get 7,Temp5,MonsterRecord
Monster.Rate(TempA,Temp)=MonsterRecord.Rate
Monster.Percent(TempA,Temp)=MonsterRecord.RatePercent
Else
Monster.Rate(TempA,Temp)=False
Monster.Percent(TempA,Temp)=False
Endif
Next
Next
Spells.Max=Lof(12)/Len(SpellRecord)
If Spells.Max=False Then
Spells.Max=1
Put 12,1,SpellRecord
Endif
Redim SpellArray(1 To Spells.Max) As SpellType
For Temp=1 To Spells.Max
Get 12,Temp,SpellArray(Temp)
Next
10281
Exit Sub
10282
Resume 10281
End Sub
Sub Init.Driver
On Local Error Goto 10292
If Local.Mode Then
Exit Sub
Endif
If Port.Override>False Then
Port=Port.Override-1
Else
Port=Config2(46)-1
Endif
Call Driver(1)
If (Outregs.AX<>&H1954) Then
Strng="FOSSIL driver not installed."
Call Error.Message
Endif
10291
Exit Sub
10292
Resume 10291
End Sub
Sub Drop.DTR
On Local Error Goto 10302
Call Driver(3)
Call Driver(2)
Call Driver(14)
Call Driver(15)
Call Pause.Second
Call Driver(3)
Call Pause.Second
10301
Exit Sub
10302
Resume 10301
End Sub
Sub Driver(Var)
On Local Error Goto 10312
Select Case Var
Case 1
Inregs.AX=&H0400
Case 2
Inregs.AX=&H0600
Case 3
Inregs.AX=&H0601
Case 4
If Config2(65) Then
Exit Sub
Endif
Select Case Modem.Baud
Case 3
Inregs.AX=&H0043
Case 6
Inregs.AX=&H0063
Case 12
Inregs.AX=&H0083
Case 24
Inregs.AX=&H00A3
Case 48
Inregs.AX=&H00C3
Case 96
Inregs.AX=&H00E3
Case 192
Inregs.AX=&H0003
Case 384
Inregs.AX=&H0023
End Select
Case 5
Inregs.AX=&H0300
Case 6
Inregs.AX=&H2000
Case 7
Inregs.AX=Inregs.AX Or &H0B00
Case 11
Inregs.AX=&H1001
Case 13
Inregs.AX=&H0F00
If Config2(79) Then
Inregs.AX=Inregs.AX Or &H09
Endif
If Config2(80) Then
Inregs.AX=Inregs.AX Or &H02
Endif
Case 14
Inregs.AX=&H0A00
Case 15
Inregs.AX=&H0900
End Select
Inregs.DX=Port
Call Interrupt(&H14,Inregs,Outregs)
10311
Exit Sub
10312
Resume 10311
End Sub
Sub Get.Command
On Local Error Goto 10322
Port.Override=False
Time.Override=False
Inregs.AX=&H0F00
Call Interrupt(&H10,Inregs,Outregs)
Video.Page=Outregs.BX
Var=False
Count=False
Temp$=Command$
Local.Mode=False
Local.Avatar=False
If Config2(84) And Config2(85) Then
Local.Avatar=True
Endif
If Temp$="?" Or Temp$="HELP" Then
Call Boot.Usage
Endif
If Temp$=Nul Then
Call Boot.Usage
Endif
Var1=Instr(Temp$,"NAME="+Quote$)
If Var1 Then
Var1$=Left$(Temp$,Var1-1)
Temp2$=Mid$(Temp$,Var1+6)
Var2=Instr(Temp2$,Quote$)
If Var2 Then
Temp$=Rtrim$(Var1$)+Mid$(Temp2$,Var2+1)
Temp2$=Left$(Temp2$,Var2-1)
If Temp2$<>Nul Then
Bypass.CodeName=Temp2$
Bypass.Login=True
Var=True
Endif
Endif
Endif
While Len(Temp$)
Var1=Instr(Temp$," ")
If Var1=False Then
Temp2$=Temp$
Temp$=Nul
Else
Temp2$=Left$(Temp$,Var1-1)
Temp$=Mid$(Temp$,Var1+1)
Endif
TempX=False
Count=Count+1
If Count=1 And Len(Temp2$)=1 Then
Node=Asc(Temp2$)
Noden=False
If Node>=48 And Node<=57 Then
Noden=Node-48
Endif
If Node>=65 And Node<=90 Then
Noden=Node-55
Endif
If Noden=False Then
Strng="NODE must range from 0-9, or A-Z."
Call Error.Message
Endif
TempX=True
Var=True
Endif
If Temp2$="BBS" Then
TempX=True
Var=True
Endif
If Temp2$="LOCAL" Then
Local.Mode=True
TempX=True
Var=True
Endif
If Temp2$="BYPASS" Then
Bypass.Screen=True
TempX=True
Var=True
Endif
If Temp2$="DISABLE" Then
Disable.DM=True
TempX=True
Var=True
Endif
If Left$(Temp2$,3)="/P:" Then
If Len(Temp2$)=4 Then
VarP=Val(Mid$(Temp2$,4,1))
If VarP>=1 And Varp<=8 Then
Port.Override=VarP
TempX=True
Var=True
Endif
Endif
Endif
If Left$(Temp2$,3)="/T:" Then
Time.Override=Int(Val(Mid$(Temp2$,4)))
TempX=True
Var=True
Endif
If TempX=False Then
Call Boot.Usage
Endif
Wend
If Var=False Then
Call Boot.Usage
Endif
10321
Exit Sub
10322
Resume 10321
End Sub
Sub Boot.Usage
On Local Error Goto 10332
Return$=Chr$(13)+Chr$(10)
Strng="DNDBBS usage:"+Return$
Call Put.Screen(Strng)
Strng=" DNDBBS [node] <boot> (flag)"+Return$
Call Put.Screen(Strng)
Strng=" [node] is optional (0 to 9, or A to Z),"+Return$
Call Put.Screen(Strng)
Strng=" <boot> is bbs, local, bypass, disable, and/or, "+_
"name="+Chr$(34)+"username"+Chr$(34)+","+Return$
Call Put.Screen(Strng)
Strng=" (flag) is optional:"+Return$
Call Put.Screen(Strng)
Strng=" /P:n where n is port override (1-8), and/or,"+Return$
Call Put.Screen(Strng)
Strng=" /T:n where n is time limit (in minutes)."
Call Put.Screen(Strng)
10331
End
10332
Resume 10331
End Sub
Sub Shell.Program(Var$,Var1,Var2)
On Local Error Goto 10342
If Logged.In=False Then
Call Clear.Screen
Endif
If Logged.In Then
Put 3,User.Index,UserRecord
Call Status.Line(-2)
Endif
Close #13
Open Temp.FileName For Output Shared As #13
Temp=Color.Code
If Local.Mode Then
If Local.Avatar Then
Temp=Avatar.Code
Endif
Else
If Extended.ANSI Then
Temp=Avatar.Code
Endif
Endif
Print #13,Temp
Close
Chained=False
Var2$=DND.Path+Var$
If Config2(83)=False Then
Remote=Local.Mode
Local.Mode=Var1
Shelled=Var2
Chained=True
Chain Var2$
Endif
Var2$=Var2$+" "+Ltrim$(Str$(Var1))+" "
If Node Then
Var2$=Var2$+Chr$(Node)
Else
Var2$=Var2$+"-1"
Endif
Shell Var2$
If Max.Row=22 Then
Locate 23,1,1
Strng=Nul
Call IO.O
Endif
Call Get.Config
Call Open.Files
Call Read.Data
If Logged.In Then
Get 3,User.Index,UserRecord
Call Status.Line(1)
Call Display.Room
Endif
10341
Exit Sub
10342
Resume 10341
End Sub
Sub Top.Ten
On Local Error Goto 10354
Put 3,User.Index,UserRecord
Strng="(hit <control-k> to interrupt).."
Call IO.O
Graphics.Off=True
TempX=Lof(3)/Len(UserRecord)
Redim Temp.Array1(1 To TempX) As Integer,_
Temp.ArrayZ(1 To TempX) As Double
Strng="DNDBBS V"+Version$+" Top Ten Player Rankings For "+_
Left$(FNclock$,13)+"."
Call IO.O
Strng=Nul
Call IO.O
TempZ=False
For Temp.User.Index=1 To TempX
Get 3,Temp.User.Index,UserRecord
Strng=UserRecord.CodeName
Call Decrypt(Strng)
If (UserRecord.Flags And Locked.User)=False Then
If Left$(Strng,9)<>Deleted$ Then
If UserRecord.Level>1 Then
TempZ=TempZ+1
Temp.Array1(TempZ)=Temp.User.Index
10351 TempA#=UserRecord.PlayersKilled*UserRecord.Level*2+_
UserRecord.MonstersKilled*UserRecord.Level
10352 Temp.ArrayZ(TempZ)=TempA#
Endif
Endif
Endif
Next
Call Sort.Array(TempZ,2)
If TempZ>10 Then
TempZ=10
Endif
Strng="Username Level Classname Ranking"
Call IO.O
Strng=String$(64,"-")
Call IO.O
TempX=False
Allow.Break=True
For Temp1=1 To TempZ
Get 3,Temp.Array1(Temp1),UserRecord
Strng=UserRecord.CodeName
Call Decrypt(Strng)
Strng=Lcase$(Strng)
Mid$(Strng,1,1)=Ucase$(Mid$(Strng,1,1))
If UserRecord.Level>32000 Then
Strng=Strng+"Ghod "
Else
Strng=Strng+Str$(UserRecord.Level)
Strng=Strng+Space$(6-Len(Str$(UserRecord.Level)))
Endif
Out2=UserRecord.ClassName
Call Decrypt(Out2)
Strng=Strng+Out2
TempX=True
Strng=Strng+Str$(Temp.ArrayZ(Temp1))
Call IO.O
If Break Then
Exit For
Endif
Next
Allow.Break=False
If TempX=False Then
Strng="No users have top scores."
Call IO.O
Endif
Call More.Prompt
Get 3,User.Index,UserRecord
Redim Temp.Array1(1) As Integer,_
Temp.ArrayZ(1) As Double
10353
Exit Sub
10354
If Erl=10351 Then
Resume 10352
Endif
Resume 10353
End Sub
Sub Clean.UpdateFile
On Local Error Goto 10362
Close 13
Open FileName For Input Shared As #13
Line Input #13,Temp$
Strng=FNclock$
If Left$(Temp$,9)<>Mid$(Strng,5,9) Then
Close 13
Kill FileName
Endif
10361
Exit Sub
10362
Resume 10361
End Sub
Sub Clear.LogFile
On Local Error Goto 10372
Close 13
Open Log.FileName For Random Shared As #13 Len=Len(LogRecord)
For Temp1=1 To Lof(13)/Len(LogRecord)
Get 13,Temp1,LogRecord
If LogRecord.User=User.Index Then
LogRecord.User=False
LogRecord.Message=Nul
Put 13,Temp1,LogRecord
Endif
Next
10371
Exit Sub
10372
Resume 10371
End Sub
Sub Display.LogFile
On Local Error Goto 10382
Close 13
Open Log.FileName For Random Shared As #13 Len=Len(LogRecord)
For Temp1=1 To Lof(13)/Len(LogRecord)
Get 13,Temp1,LogRecord
If LogRecord.User=User.Index Then
Strng=Rtrim$(LogRecord.Message)
Call IO.O
LogRecord.User=False
LogRecord.Message=Nul
Put 13,Temp1,LogRecord
Endif
Next
10381
Exit Sub
10382
Resume 10381
End Sub
Sub More.Prompt
On Local Error Goto 10392
Strng=More$
Line.Length=1
No.Echo=True
Call IO.I
10391
Exit Sub
10392
Resume 10391
End Sub
Sub IO.O
On Local Error Goto 10402
Static Wrap.Limit
If Lost.Carrier Then
Exit Sub
Endif
If Color.Graphics Then
Gosub Out.ANSI
Endif
If Carriage.Return=False Then
If Carriage.Input=False Then
Strng=Rtrim$(Strng)
Endif
Endif
Break=False
For Count=1 To Len(Strng)
Call Keyboard(Var)
If Chat.Flag Then
Chat.Flag=False
Exit Sub
Endif
If Wrap.Limit>False Or Carriage.Return Then
OutX$=Mid$(Strng,Count)
If Instr(OutX$," ") Then
OutX$=Left$(OutX$,Instr(OutX$," "))
Endif
If Wrap.Limit+Len(OutX$)>80 Then
Call Line.Return
Wrap.Limit=False
Endif
Wrap.Limit=Wrap.Limit+1
If Mid$(Strng,Count,1)=" " Then
If Wrap.Limit>79 Then
Call Put.Modem(" ")
Wrap.Limit=False
Count=Count+1
Endif
If Wrap.Limit>78 Then
Call Line.Return
Wrap.Limit=False
Count=Count+1
Endif
Endif
Endif
If Break Then
Exit For
Endif
VarX$=Mid$(Strng,Count,1)
Call Put.Modem(VarX$)
Call Scrn(VarX$)
Next
If Carriage.Return=False Then
If Carriage.Input=False Then
Wrap.Limit=False
Call Line.Return
Endif
Endif
Strng=Nul
Carriage.Return=False
Carriage.Input=False
Exit Sub
Out.ANSI:
If Graphics.Off=False Then
Color.Code=Color.Code+1
Avatar.Code=Avatar.Code+1
If Color.Code<31 Then
Color.Code=31
Endif
If Avatar.Code<10 Then
Avatar.Code=10
Endif
If Color.Code>35 Then
Color.Code=31
Endif
If Avatar.Code>14 Then
Avatar.Code=10
Endif
Call Screen.ANSI(4,Color.Code,Avatar.Code)
Call Modem.ANSI(4,Color.Code,Avatar.Code)
Endif
If Graphics.Off Then
Call Screen.ANSI(4,37,15)
Call Modem.ANSI(4,37,15)
Endif
Return
10401
Exit Sub
10402
Resume 10401
End Sub
Sub IO.I
On Local Error Goto 10412
Static Var$
If Lost.Carrier Then
Exit Sub
Endif
Carriage.Input=True
Line.Limit=Len(Strng)
Strng=Strng+Var$
Call IO.O
Out2=Var$
Var$=Nul
Do
Char$=Nul
Timeout!=Timer+Config2(56)
Do While Char$=Nul And Not Lost.Carrier
If Timeout!<=Timer Then
Call Hang.Up(1)
Exit Sub
Endif
If Timer>=Timeon Then
Temp.Time=Timer-Timeon
Else
Temp.Time=Timer+86400-Timeon
Endif
If Temp.Time>=Time.Left Then
Call Hang.Up(2)
Exit Sub
Endif
If Time.Left-Temp.Time<120 Then
If Two.Minutes.Left=False Then
Two.Minutes.Left=True
Strng=Nul
Call IO.O
Call Put.Modem(Chr$(7))
Strng="Two Minutes Left!"
Call IO.O
Exit Sub
Endif
Endif
Call Keyboard(Var)
If Var Then
Strng=Nul
Call IO.O
Exit Sub
Endif
If Chat.Flag Then
Chat.Flag=False
Exit Sub
Endif
Call Get.Modem
If Len(Buffer) Then
Char$=Left$(Buffer,1)
Buffer=Mid$(Buffer,2)
Endif
Loop
Char=Asc(Char$)
Select Case Char
Case 8
If Len(Out2) Then
Out2=Left$(Out2,Len(Out2)-1)
Call Back.Space
Endif
Case 13
If Out2=Nul Then
If Len(No.Input.Out) Then
Out2=No.Input.Out
OutY$=Lcase$(No.Input.Out)
Call Scrn(OutY$)
Call Put.Modem(OutY$)
Endif
Endif
Call Scrn(Chr$(13))
Call Put.Modem(Chr$(13))
Exit Do
Case 32 To 127
VarX$=Char$
If No.Echo=False Then
If Hide Then
VarX$=Mask$
Endif
Call Put.Modem(VarX$)
If Word.Wrap=False Then
Call Scrn(VarX$)
Endif
Endif
Out2=Out2+Char$
Select Case Word.Wrap
Case True
Select Case Len(Out2)+Line.Limit
Case 0 To 78
Call Scrn(VarX$)
Case Else
TempX=False
Word=False
For TempY=Len(Out2) To 1 Step -1
If Mid$(Out2,TempY,1)=" " Then
For Var=1 To TempX
Call Back.Space
Next
Var$=Mid$(Out2,TempY+1)
Out2=Left$(Out2,TempY)
Call Scrn(Chr$(13))
Word=True
Exit For
Endif
TempX=TempX+1
Next
If Word=False Then
Call Scrn(Chr$(13))
Endif
Call Put.Modem(Chr$(13))
Exit Do
End Select
Case False
If Line.Length>False Then
If Len(Out2)>=Line.Length Then
Call Scrn(Chr$(13))
Call Put.Modem(Chr$(13))
Exit Do
Endif
Endif
End Select
End Select
Loop
Strng=Nul
No.Echo=False
No.Input=False
Line.Length=False
If Out2=Nul Then
No.Input=True
Endif
No.Input.Out=Nul
Call Put.Modem(Chr$(10))
Var1$=Left$(Out2,1)
Yes=Ucase$(Var1$)="Y"
No=Ucase$(Var1$)="N"
10411
Exit Sub
10412
Resume 10411
End Sub
Sub Put.Modem(Var$)
On Local Error Goto 10422
If Local.Mode Then
Exit Sub
Endif
If Lost.Carrier Then
Exit Sub
Endif
For Count=1 To Len(Var$)
Call Check.Carrier
If Allow.Break Then
Call Driver(11)
If (Outregs.AX And &H0001)=1 Then
If Wait.Mode Or Auto.Mode Or Follow.Mode Then
Auto.Break=True
Else
Break=True
Endif
Exit For
Endif
Endif
Call Get.Modem
Inregs.AX=Asc(Mid$(Var$,Count,1))
Call Driver(7)
Next
10421
Exit Sub
10422
Resume 10421
End Sub
Sub Get.Modem
On Local Error Goto 10432
If Local.Mode Then
Exit Sub
Endif
If Lost.Carrier Then
Exit Sub
Endif
Call Check.Carrier
Call Driver(6)
Char=Outregs.AX And &HFF
If Char<>&HFF Then
Buffer=Buffer+Chr$(Char)
Endif
10431
Exit Sub
10432
Resume 10431
End Sub
Sub Check.Carrier
On Local Error Goto 10442
If Lost.Carrier Then
Exit Sub
Endif
Call Driver(5)
If (Outregs.AX And &H80)=False Then
Call Hang.Up(3)
Exit Sub
Endif
10441
Exit Sub
10442
Resume 10441
End Sub
Sub Keyboard(Var1)
On Local Error Goto 10452
VarX$=Inkey$
Var1=False
Select Case Len(VarX$)
Case 0
Exit Sub
Case 1
Var=Asc(VarX$)
Select Case Var
Case 8, 13, 32 To 127
Buffer=Buffer+VarX$
Case 11
If Allow.Break Then
Break=True
If Wait.Mode Or Auto.Mode Or Follow.Mode Then
Auto.Break=True
Endif
Endif
Case 27
If Chat Then
Chat.Flag=True
Chat=False
Else
Call Status.Line(True)
Endif
End Select
Case 2
If Asc(Right$(VarX$,1))=79 Then
Call Hang.Up(4)
Exit Sub
Endif
If Local.Mode=False Then
Func.Buffer=Right$(VarX$,1)
Var1=True
Endif
End Select
10451
Exit Sub
10452
Resume 10451
End Sub
Sub Line.Return
On Local Error Goto 10462
Var$=Chr$(13)
Call Scrn(Var$)
Call Put.Modem(Var$)
Var$=Chr$(10)
Call Put.Modem(Var$)
10461
Exit Sub
10462
Resume 10461
End Sub
Sub Back.Space
On Local Error Goto 10472
Var$=Chr$(27)+"[D"+" "+Chr$(27)+"[D"
Call Scrn(Var$)
Var$=Chr$(8)+" "+Chr$(8)
Call Put.Modem(Var$)
10471
Exit Sub
10472
Resume 10471
End Sub
Sub Function.Key(Var)
On Local Error Goto 10482
If Local.Mode Then
Exit Sub
Endif
Strng=Nul
Out2=Nul
Select Case Var
Case 59
Strng="System Operator is using "+Config3(9)+"Edit. Please wait.."
Call IO.O
Call Shell.Program("edit.exe",True,True)
Case 60
Local.Mode=True
Call Display.Memory
Local.Mode=False
Case 61
Local.Mode=True
Strng=Action.Prompt+Config3(9)+"DIS "
Call IO.I
Parsed.Command1=Ucase$(Out2)
Call Discard.Object
Local.Mode=False
Case 62
Local.Mode=True
Strng=Action.Prompt+Config3(9)+"REDUCE "
Call IO.I
Parsed.Command1=Out2
Call Reduce.Monsters
Local.Mode=False
Case 63
Local.Mode=True
Strng=Action.Prompt+Config3(9)+"CALL "
Call IO.I
Local.Mode=False
Parsed.Command1=Out2
Call Summon.Monster
Case 64
Local.Mode=True
Strng=Action.Prompt+Config3(9)+"KILL "
Call IO.I
Local.Mode=False
Parsed.Command1=Ucase$(Out2)
Parsed.Command2=Parsed.Command1
Call Kill.Monster
Case 65
Local.Mode=True
Strng=Action.Prompt+Config3(9)+"TELE "
Call IO.I
Local.Mode=False
Parsed.Command1=Out2
Parsed.Command2=Parsed.Command1
Call Teleport.User
Case 66
Call Invisibility
Case 67
Local.Mode=True
Strng=Action.Prompt+Config3(9)+"GET "
Call IO.I
Local.Mode=False
Out2=Ucase$(Out2)
Stored.Parsed.Command2=Out2
Call Drop.Object
Case 68
Local.Mode=True
Call Link.Room
Local.Mode=False
Case 71
Buffer=Nul
Func.Buffer=Nul
If Chat=False Then
Chat=True
Call Enter.Chat
Endif
Chat=False
End Select
Strng=Nul
Out2=Nul
10481
Exit Sub
10482
Resume 10481
End Sub
Sub Hang.Up(Var)
On Local Error Goto 10492
If Lost.Carrier Then
Exit Sub
Endif
Strng=Nul
Out2=Nul
Buffer=Nul
Func.Buffer=Nul
Timeon=Timer
Time.Left=180
Select Case Var
Case 1
Call IO.O
OutZ="Connect timeout"
Strng=OutZ+"!"
Call IO.O
Case 2
Call IO.O
OutZ="Time limit exceeded"
Strng=OutZ+"!"
Call IO.O
Case 3
OutZ="Lost carrier"
If Lost.Carrier=False Then
Strng=Chr$(13)+Chr$(10)+OutZ+"!"
Call Scrn(Strng)
Endif
Strng=Nul
Case 4
Call IO.O
OutZ="Forced logoff"
Strng=OutZ+"!"
Call IO.O
Case 5
Call IO.O
OutZ="Call limit exceeded"
Strng=OutZ+"!"
Call IO.O
Case 6
Call IO.O
Call Restriction.Notice
OutZ="Call time restriction"
Case 7
Call IO.O
OutZ="Illegal login attempt"
Strng=OutZ+"!"
Call IO.O
Case 8
Call IO.O
OutZ="Password verification"
Strng=OutZ+"!"
Call IO.O
Case 9
Call IO.O
OutZ="Not resurrected"
Strng=OutZ+"!"
Call IO.O
Case 10
Call IO.O
OutZ="Nondescriptive data files"
Strng=OutZ+"!"
Call IO.O
End Select
10491
Security.Guard=False
Lost.Carrier=True
Exit Sub
10492
Resume 10491
End Sub
Sub Restriction.Notice
On Local Error Goto 10502
Strng="Your calls are restricted from"
Temp5=UserRecord.FromHour
If Temp5>12 Then
Strng=Strng+Str$(UserRecord.FromHour-12)
Out2="pm"
Else
Strng=Strng+Str$(UserRecord.FromHour)
Out2="am"
Endif
Strng=Strng+":"+Right$(Str$(UserRecord.FromMin+100),2)+Out2+" to"
Temp5=UserRecord.ToHour
If Temp5>12 Then
Strng=Strng+Str$(UserRecord.ToHour-12)
Out2="pm"
Else
Strng=Strng+Str$(UserRecord.ToHour)
Out2="am"
Endif
Strng=Strng+":"+Right$(Str$(UserRecord.ToMin+100),2)+Out2+"."
Call IO.O
10501
Exit Sub
10502
Resume 10501
End Sub
Sub Out.File(Var$)
On Local Error Goto 10512
Graphics.Off=True
Allow.Break=True
TempX=False
TempZ=False
Close 13
Open Var$ For Input Shared As #13
Do While Not Eof(13) And Not Lost.Carrier
Line Input #13,Strng
Call IO.O
If Break Then
Exit Do
Endif
TempX=TempX+1
If TempX=23 Then
TempX=False
TempZ=TempZ+1
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Loop
Graphics.Off=False
If TempZ>False Then
If TempX>False Then
Call More.Prompt
Endif
Endif
10511
Allow.Break=False
Exit Sub
10512
Resume 10511
End Sub
Sub Read.DayFile(Var)
On Local Error Goto 10522
If Var Then
FileName=Day.File.FileName
Else
FileName=Day.Log.FileName
Endif
Out5=FNclock$
Out5=Mid$(Out5,5,9)
TempX=False
Strng="Dayfile for "+Out5+"."
Call IO.O
Graphics.Off=True
Temp5=1
Close 13
Open FileName For Input Shared As #13
Do While Not Eof(13) And Not Lost.Carrier
Line Input #13,Strng
If Left$(Strng,9)=Out5 Then
Call IO.O
TempX=True
Temp5=Temp5+1
Endif
If Temp5=23 Then
Temp5=False
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Loop
If TempX=False Then
Strng="No dayfile log for "+Out5+"."
Call IO.O
Exit Sub
Endif
Strng=Nul
Call IO.O
Graphics.Off=False
Strng="Press "+Enter$+" to continue:"
Line.Length=1
No.Echo=True
Call IO.I
No.Echo=False
10521
Exit Sub
10522
Resume 10521
End Sub
Sub Update.Dayfile(Var$,Var)
On Local Error Goto 10532
Temp$=UserRecord.CodeName
Call Decrypt(Temp$)
Temp$=Rtrim$(Temp$)
Temp$=Lcase$(Temp$)
If Temp$=Nul Then
Temp$="(prelogin)"
Endif
Mid$(Temp$,1,1)=Ucase$(Mid$(Temp$,1,1))
Mid$(Var$,1,1)=Ucase$(Mid$(Var$,1,1))
TempX$=FNclock$
TempX$=Mid$(TempX$,5,11)+Temp$+": "+Var$+"."
FileName=Day.Log.FileName
If Var Then
FileName=Day.File.FileName
Endif
Close 13
Open FileName For Append Shared As #13
Print #13,TempX$
10531
Exit Sub
10532
Resume 10531
End Sub
Sub Update.Mess(Var)
On Local Error Goto 10542
If Node<=False Then
Exit Sub
Endif
Call Zero.Node(Noden+1)
Select Case Var
Case True
Exit Sub
Case 1
MessWorkRecord1.UserName="Login"
Case 2
MessWorkRecord1.UserName="Relogin"
Case 3
MessWorkRecord1.UserName="Logoff"
Case 4
Strng=UserRecord.CodeName
Call Decrypt(Strng)
MessWorkRecord1.UserName=Strng
End Select
Strng=UserRecord.ClassName
Call Decrypt(Strng)
MessWorkRecord1.ClassName=Strng
MessWorkRecord1.TimeOn=Time.On
MessWorkRecord1.LastCommand=Last.Command
MessWorkRecord1.RoomNumber=Room
MessWorkRecord1.UserIndex=User.Index
MessWorkRecord1.Level=UserRecord.Level
MessWorkRecord1.Fatigue=UserRecord.Fatigue
MessWorkRecord1.FatigueMax=UserRecord.FatigueMax
MessWorkRecord1.Vitality=UserRecord.Vitality
MessWorkRecord1.VitalityMax=UserRecord.VitalityMax
MessWorkRecord1.Magic=UserRecord.Magic
MessWorkRecord1.MagicMax=UserRecord.MagicMax
MessWorkRecord1.Psionic=UserRecord.Psionic
MessWorkRecord1.PsionicMax=UserRecord.PsionicMax
MessWorkRecord1.Gold=UserRecord.Gold
MessWorkRecord1.Experience=UserRecord.Experience
MessWorkRecord1.Align1=UserRecord.Align1
MessWorkRecord1.Align2=UserRecord.Align2
For Var1=1 To 7
MessWorkRecord1.Stats(Var1)=UserRecord.Stats(Var1)
Next
For Var1=1 To 4
MessWorkRecord1.Weapons(Var1)=UserRecord.Weapons(Var1)
Next
MessWorkRecord1.Invisible=UserRecord.Invisible
MessWorkRecord1.ClassType=UserRecord.ClassType
MessWorkRecord1.Score1=Players.Killed
MessWorkRecord1.Score2=Monsters.Killed
MessWorkRecord1.Race=UserRecord.Race
For Var1=1 To 20
MessWorkRecord1.Treasure(Var1)=False
Next
For Var1=1 To 20
MessWorkRecord1.TreasureCharges(Var1)=False
Next
MessWorkRecord1.NextRecord=True
Put 1,Noden+1,MessWorkRecord1
Var2=Noden+1
Var1=False
For VarX=1 To Number.Inventory
If Var1=20 Then
Var1=False
Put 1,Var2,MessWorkRecord1
Var3=Var2
Var2=36
Do
Var2=Var2+1
Get 1,Var2,MessWorkRecord1
If MessWorkRecord1.NextRecord=False Then
Exit Do
Endif
If Var2>Lof(1)/Len(MessWorkRecord1) Then
Exit Do
Endif
Loop
Get 1,Var3,MessWorkRecord1
MessWorkRecord1.NextRecord=Var2
Put 1,Var3,MessWorkRecord1
Call Zero.Node(Var2)
MessWorkRecord1.NextRecord=True
Endif
Var1=Var1+1
MessWorkRecord1.Treasure(Var1)=Treasure(VarX)
MessWorkRecord1.TreasureCharges(Var1)=Treasure.Charges(VarX)
Next
Put 1,Var2,MessWorkRecord1
10541
Exit Sub
10542
Resume 10541
End Sub
Sub Zero.Node(Var)
On Local Error Goto 10552
Get 1,Var,MessWorkRecord1
MessWorkRecord1.UserName="<offline>"
MessWorkRecord1.ClassName="<offline>"
MessWorkRecord1.TimeOn=Nul
MessWorkRecord1.LastCommand=Nul
MessWorkRecord1.RoomNumber=False
MessWorkRecord1.UserIndex=False
MessWorkRecord1.Level=False
MessWorkRecord1.Fatigue=False
MessWorkRecord1.FatigueMax=False
MessWorkRecord1.Vitality=False
MessWorkRecord1.VitalityMax=False
MessWorkRecord1.Magic=False
MessWorkRecord1.MagicMax=False
MessWorkRecord1.Psionic=False
MessWorkRecord1.PsionicMax=False
MessWorkRecord1.Gold=False
MessWorkRecord1.Experience=False
MessWorkRecord1.Align1=False
MessWorkRecord1.Align2=False
For Var1=1 To 7
MessWorkRecord1.Stats(Var1)=False
Next
For Var1=1 To 4
MessWorkRecord1.Weapons(Var1)=False
Next
MessWorkRecord1.Invisible=False
MessWorkRecord1.ClassType=False
MessWorkRecord1.Race=False
For Var1=1 To 20
MessWorkRecord1.Treasure(Var1)=False
Next
For Var1=1 To 20
MessWorkRecord1.TreasureCharges(Var1)=False
Next
Var2=MessWorkRecord1.NextRecord
MessWorkRecord1.NextRecord=False
Var3=Lof(1)/Len(MessWorkRecord1)
If Var3<36 Then
Var3=Var3+1
Put 1,Var3,MessWorkRecord1
Call Zero.Node(Var3)
Endif
Put 1,Var,MessWorkRecord1
If Var2>False Then
Call Zero.Node(Var2)
Endif
10551
Exit Sub
10552
Resume 10551
End Sub
Sub Read.Status
On Local Error Goto 10562
Strng="(hit <control-k> to interrupt).."
Call IO.O
Graphics.Off=True
Strng="DNDBBS V"+Version$+" Status Report For "+Left$(FNclock$,13)+"."
Call IO.O
Strng=Nul
Call IO.O
Strng="P# Username Timeon Last Command Classname"
Call IO.O
Strng=String$(68,"-")
Call IO.O
If Node=False Then
Out2=Last.Command
Out2=Left$(Out2,15)
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Out2=Out2+Space$(15-Len(Out2))
Strng=UserRecord.CodeName
Call Decrypt(Strng)
Strng=Rtrim$(Strng)
Strng=Lcase$(Strng)
Mid$(Strng,1,1)=Ucase$(Mid$(Strng,1,1))
Strng=Strng+Space$(30-Len(Strng))
Strng=Mask$+Mask$+" "+Strng+" "+Time.On+" "+Out2+" "
Out2=UserRecord.ClassName
Call Decrypt(Out2)
Strng=Strng+Out2
Call IO.O
Call More.Prompt
Exit Sub
Endif
Temp3=3
Allow.Break=True
For Temp5=1 To 36
Get 1,Temp5,MessWorkRecord1
If MessWorkRecord1.UserIndex>False Then
Strng=MessWorkRecord1.UserName
Strng=Rtrim$(Strng)
If Left$(Strng,9)<>"<offline>" Then
Strng=Lcase$(Strng)
Mid$(Strng,1,1)=Ucase$(Mid$(Strng,1,1))
Out2=MessWorkRecord1.LastCommand
Out2=Left$(Out2,15)
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Out2=Out2+Space$(15-Len(Out2))
Out3=MessWorkRecord1.ClassName
Out3=Rtrim$(Out3)
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+" "+MessWorkRecord1.TimeOn+" "+Out2+" "+Out3
If Temp5<=10 Then
Strng="P"+Mid$(Str$(Temp5-1),2)+" "+Strng
Else
Strng="P"+Chr$(Temp5+54)+" "+Strng
Endif
Call IO.O
If Break Then
Exit For
Endif
Temp3=Temp3+1
If Temp3=21 Then
Temp3=False
Call More.Prompt
If No Then
Exit For
Endif
Endif
Endif
Endif
Next
Allow.Break=False
If Temp3>False Then
Call More.Prompt
Endif
10561
Exit Sub
10562
Resume 10561
End Sub
Sub Read.Mess
On Local Error Goto 10572
If Node<=False Then
Exit Sub
Endif
Var1=False
Redim Temp.ArrayS(1 To 10) As String,_
Temp.Array1(1 To 10) As Integer,_
Temp.Array2(1 To 10) As Integer,_
Temp.ArrayX(1 To 10) As Single
Graphics.Off=True
TempQ=False
Get 1,Noden+1,MessWorkRecord1
If Left$(MessWorkRecord1.LastCommand,6)="<dead>" Then
TempQ=True
Endif
If MessWorkRecord1.OfferTime=True Then
If TempQ=False Then
Strng="The offer was accepted!"
Call IO.O
Endif
Var1=MessWorkRecord1.GoldOffer
If Var1>False Then
Var2=True
UserRecord.Gold=UserRecord.Gold-Var1
If UserRecord.Gold<False Then
UserRecord.Gold=False
Var2=False
Endif
Else
Var=False
For Temp5=1 To Number.Inventory
If Treasure(Temp5)=MessWorkRecord1.ItemOffer Then
Var2=True
Call Discard(Temp5,True)
Exit For
Endif
Next
Endif
If Var2=False Then
If TempQ=False Then
Strng="You don't have the items to trade!"
Call IO.O
Endif
Else
Var1=MessWorkRecord1.GoldFor
If Var1>False Then
UserRecord.Gold=UserRecord.Gold+Var1
Else
Temp7=MessWorkRecord1.ItemFor
Temp6=MessWorkRecord1.ForCharges
Call Add.Inventory(Temp7,Temp6)
Endif
Endif
MessWorkRecord1.OfferTime=False
Put 1,Noden+1,MessWorkRecord1
Endif
If MessWorkRecord1.OfferTime>False Then
If Timer>MessWorkRecord1.OfferTime Then
MessWorkRecord1.OfferTime=False
Put 1,Noden+1,MessWorkRecord1
If TempQ=False Then
Strng="Offer expired."
Call IO.O
Endif
Endif
Endif
For Var=1 To Lof(2)/Len(MessWorkRecord2)
If Var1=10 Then
Exit For
Endif
Get 2,Var,MessWorkRecord2
If Mid$(MessWorkRecord2.Flags,Noden+1,1)="0" Then
If TempQ Then
Var1=1
Else
Var1=Var1+1
Endif
Out3=MessWorkRecord2.UserName
Out3=Rtrim$(Out3)
Out3=Lcase$(Out3)
Mid$(Out3,1,1)=Ucase$(Mid$(Out3,1,1))
Temp.Array2(Var1)=MessWorkRecord2.UserIndex
Select Case MessWorkRecord2.MessageType
Case 1
Strng=Out3+" Sends: "+MessWorkRecord2.Message
Case 2
Strng=Out3+" Yells: "+MessWorkRecord2.Message
Case 3
Strng=Out3+" Says: "+MessWorkRecord2.Message
Case 4
Strng=Mask$+Mask$+Mask$+" "+Out3+": "+MessWorkRecord2.Message
Case 5, 8
Strng=MessWorkRecord2.Message
Case 6
Strng=Out3+" Sends to you: "+MessWorkRecord2.Message
Case 7
Strng=Out3+" Whispers: "+MessWorkRecord2.Message
Case 9
Strng=Out3
Temp.Array2(Var1)=Cint(Val(Left$(MessWorkRecord2.Message,6)))
Case 10
Strng=Out3+" Transmits: "+MessWorkRecord2.Message
Case 11
Strng=Out3+": "+MessWorkRecord2.Message
Case 12, 14
Strng=Out3+" aborted program!"
Case 13
Out2=MessWorkRecord2.Message
Strng=Out3+Chr$(1)+Left$(Out2,Instr(2,Out2," "))
Temp.Array2(Var1)=Val(Mid$(Out2,Instr(2,Out2," ")))
Case 15
Out2=MessWorkRecord2.Message
Strng=Out3+Chr$(1)+Str$(Val(Out2))
Case 16
Strng=Out3
Temp.Array2(Var1)=Val(MessWorkRecord2.Message)
Case 17
Strng="You were just struck dead!"
Case 18
Strng="You were just teleported elsewhere!"
Temp.Array2(Var1)=Val(MessWorkRecord2.Message)
Case 19
Strng=Out3+" "+MessWorkRecord2.Message
Case 20
Strng=Out3+" loses you!"
Temp.Array2(Var1)=MessWorkRecord2.UserIndex
Case 21
Strng=Out3+" launchs "+MessWorkRecord2.Message
Strng=Rtrim$(Strng)
Strng=Strng+" at you!"
Case 22
Strng=Out3+" fires "+MessWorkRecord2.Message
Strng=Rtrim$(Strng)
Strng=Strng+" at you!"
Case 23
Strng=Out3+" blesses you!"
Case 24
Strng=Out3+" curses you!"
End Select
Temp.ArrayS(Var1)=Rtrim$(Strng)
Temp.Array1(Var1)=MessWorkRecord2.MessageType
Temp.ArrayX(Var1)=MessWorkRecord2.MessageTime
Mid$(MessWorkRecord2.Flags,Noden+1,1)="1"
Node.Work.Array1(Var1)=MessWorkRecord2.Flags
Put 2,Var,MessWorkRecord2
Endif
Next
If TempQ Then
Exit Sub
Endif
If Var1=False Then
Exit Sub
Endif
Call Sort.Array(Var1,3)
For VarX=1 To Var1
Select Case Temp.Array1(VarX)
Case 9
Strng=Temp.ArrayS(VarX)+" attacks you!"
Call IO.O
Strng=Temp.ArrayS(VarX)+" hits you for"
Temp2=Temp.Array2(VarX)
Call Player.Attack
If UserRecord.Vitality<=False Then
Exit For
Endif
Case 12, 14
Strng=Temp.ArrayS(VarX)
Call IO.O
Call Abort
Case 13
Out2=Temp.ArrayS(VarX)
Out2=Mid$(Out2,Instr(Out2,Chr$(1))+1)
Out3=Temp.ArrayS(VarX)
Out3=Left$(Out3,Instr(Out3,Chr$(1))-1)
Temp=Val(Out2)
If Temp>False And Temp<=Lof(8)/Len(TreasureRecord) Then
Get 8,Temp,TreasureRecord
Out2=TreasureRecord.TreasureName
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
Strng=Out3+" gives you "+Out2+"!"
Call IO.O
Temp8=Temp
Temp9=Temp.Array2(VarX)
Call Add.Inventory(Temp8,Temp9)
Endif
Case 15
Out2=Temp.ArrayS(VarX)
Out2=Mid$(Out2,Instr(Out2,Chr$(1))+1)
Out3=Temp.ArrayS(VarX)
Out3=Left$(Out3,Instr(Out3,Chr$(1))-1)
Temp#=Val(Out2)
Strng=Out3+" gives you"+Str$(Temp#)+" gold!"
Call IO.O
UserRecord.Gold=UserRecord.Gold+Temp#
Case 16
For Temp5=1 To Number.Inventory
If Treasure(Temp5)=Temp.Array2(VarX) Then
Get 8,Treasure(Temp5),TreasureRecord
Out2=TreasureRecord.TreasureName
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
If Rnd>.66 Then
Out3=Temp.ArrayS(VarX)
Out3=Lcase$(Out3)
Strng="You catch "+Out3+" stealing "+Out2+" from you!"
Call IO.O
Endif
Call Discard(Temp5,True)
Exit For
Endif
Next
Case 17
Message1="You were just killed!"
Strng="was killed by the Ghods!"
Call Update.DayFile(Strng,False)
Call Player.Died
Case 18
Strng=Temp.ArrayS(VarX)
Call IO.O
Next.Room=Temp.Array2(VarX)
Call Teleport
Call Enter.Room
Case 19
Strng=Temp.ArrayS(VarX)
Call IO.O
Strng="Type 'Accept' to trade."
Call IO.O
Case 20
If Follow.Mode Then
If Temp.Array2(VarX)=TempB Then
Strng=Temp.ArrayS(VarX)
Call IO.O
Auto.Break=True
Endif
Endif
Case 23
Strng=Temp.ArrayS(VarX)
Call IO.O
TempZ=False
UserRecord.Stats(6)=UserRecord.Stats(6)+1
If UserRecord.Stats(6)>Config2(31) Then
UserRecord.Stats(6)=Config2(31)
TempZ=True
Endif
Strng="You feel a glow about you!"
If TempZ Then
Strng="Nothing happens!"
Endif
Call IO.O
Case 24
Strng=Temp.ArrayS(VarX)
Call IO.O
Strng="You feel a darkening about you!"
Call IO.O
UserRecord.Stats(6)=UserRecord.Stats(6)-1
If UserRecord.Stats(6)<False Then
UserRecord.Stats(6)=False
Endif
Call New.Stats
If UserRecord.Vitality<=False Then
Exit For
Endif
Case Else
Strng=Temp.ArrayS(VarX)
Call IO.O
If Temp.Array2(VarX)=User.Index Then
If Temp.Array1(VarX)<4 Or Temp.Array1(VarX)=11 Then
If Node.Work.Array1(VarX)=String$(36,"1") Then
Strng="Nobody else hears you!"
Call IO.O
Endif
Endif
Endif
End Select
Next
10571
Exit Sub
10572
Resume 10571
End Sub
Sub Clear.Mess
On Local Error Goto 10582
If Node<=False Then
Exit Sub
Endif
For Var=1 To Lof(2)/Len(MessWorkRecord2)
Get 2,Var,MessWorkRecord2
Mid$(MessWorkRecord2.Flags,Noden+1,1)="1"
Put 2,Var,MessWorkRecord2
Next
10581
Exit Sub
10582
Resume 10581
End Sub
Sub Send.Mess(Var1,Var2,Var3,Var1$)
On Local Error Goto 10592
If Node<False Then
Exit Sub
Endif
If Node=False Then
Select Case Var1
Case 1, 2, 3, 10, 11
Strng="Nobody else hears you."
Call IO.O
End Select
Exit Sub
Endif
If Var1=8 Then
If UserRecord.Invisible Then
Exit Sub
Endif
Endif
Temp$=String$(36,"0")
For Temp4=0 To 35
Hidden=False
If Temp4=Noden Then
Select Case Var1
Case 1, 2, 3
If Echo Then
Hidden=True
Strng="Message sent."
Call IO.O
Endif
Case 4, 5
Hidden=False
Case 6
Strng="Message sent."
Call IO.O
Hidden=True
Case 7
Strng="Whisper sent."
Call IO.O
Hidden=True
Case 8
Hidden=True
Case 10
Strng="Telepathic message sent."
Call IO.O
Hidden=True
Case 11
Strng="Telepathic message sent."
Call IO.O
If Echo Then
Hidden=True
Endif
Case 12, 14
Strng="Program abort sent."
Call IO.O
End Select
Endif
If Hidden=False Then
Get 1,Temp4+1,MessWorkRecord1
If Var1=14 Then
If Temp4<>Var2 Then
Hidden=True
Endif
Endif
If Var2>False And MessWorkRecord1.UserIndex<>Var2 Then
Hidden=True
Endif
If Var3>False And MessWorkRecord1.RoomNumber<>Var3 Then
Hidden=True
Endif
If Var3<False Then
Hidden=True
If MessWorkRecord1.RoomNumber=Room Then
Hidden=False
Else
For Temp5=1 To 11
If RoomRecord.Direct(Temp5)>False Then
If MessWorkRecord1.RoomNumber=RoomRecord.Direct(Temp5) Then
Hidden=False
Exit For
Endif
Endif
Next
Endif
Endif
Endif
If MessWorkRecord1.UserIndex=False Then
If MessWorkRecord1.RoomNumber=False Then
Hidden=True
Endif
Endif
If Hidden Then
Mid$(Temp$,Temp4+1,1)="1"
Endif
Next
If Temp$=String$(36,"1") Then
Select Case Var1
Case 1, 2, 3, 11
Strng="Nobody else hears you!"
Call IO.O
End Select
Exit Sub
Endif
For Var=1 To Lof(2)/Len(MessWorkRecord2)
Get 2,Var,MessWorkRecord2
If MessWorkRecord2.Flags=String$(36,"1") Then
Exit For
Endif
If Timer>MessWorkRecord2.MessageTime Then
Exit For
Endif
Next
Strng=UserRecord.CodeName
Call Decrypt(Strng)
MessWorkRecord2.UserName=Strng
MessWorkRecord2.MessageType=Var1
MessWorkRecord2.UserIndex=User.Index
MessWorkRecord2.RoomNumber=Room
MessWorkRecord2.Message=Var1$
MessWorkRecord2.MessageTime=Timer+30!
MessWorkRecord2.Flags=Temp$
Put 2,Var,MessWorkRecord2
10591
Exit Sub
10592
Resume 10591
End Sub
Sub Search.Mess(Var)
On Local Error Goto 10602
Temp=False
If Node<=False Then
Exit Sub
Endif
For VarX=1 To 36
Get 1,VarX,MessWorkRecord1
Strng=Rtrim$(MessWorkRecord1.UserName)
Call Valid.Name(Strng)
TempB=MessWorkRecord1.UserIndex
TempC=VarX
Select Case Var
Case True
Node.Work.Array1(VarX)=Nul
Node.Work.Array2(VarX)=False
If MessWorkRecord1.RoomNumber=Room And TempA Then
Node.Work.Array1(VarX)=Lcase$(Strng)
Node.Work.Array2(VarX)=MessWorkRecord1.Level
Endif
Case False
If TempA Then
Strng=MessWorkRecord1.UserName
Strng=Rtrim$(Strng)
Strng=Lcase$(Strng)
Out4=Lcase$(Parsed.Command1)
If Left$(Strng,Len(Out4))=Out4 Then
Temp=MessWorkRecord1.RoomNumber
Exit Sub
Endif
Endif
Case Else
If MessWorkRecord1.UserIndex=Var And TempA Then
Temp=MessWorkRecord1.RoomNumber
Exit Sub
Endif
End Select
Next
10601
Exit Sub
10602
Resume 10601
End Sub
Sub Expand.Inventory
On Local Error Goto 10612
Treasure.Max=Treasure.Max+20
Redim Preserve Treasure(1 To Treasure.Max) As Integer,_
Treasure.Charges(1 To Treasure.Max) As Integer
Strng="Only the first 15 items will be stored when you log off."
Call IO.O
10611
Exit Sub
10612
Resume 10611
End Sub
Sub Expand.Room
On Local Error Goto 10622
Room.Treasure.Max=Room.Treasure.Max+30
Redim Preserve Room.Inventory(1 To Room.Treasure.Max) As Integer,_
Room.Inventory.Charges(1 To Room.Treasure.Max) As Integer
10621
Exit Sub
10622
Resume 10621
End Sub
Sub Expand.Monsters
On Local Error Goto 10632
Number.MonstersMax=Number.MonstersMax+25
Redim Preserve MonsterArray(1 To Number.MonstersMax) As MonsterType,_
MonsterIndex(1 To Number.MonstersMax) As Integer
10631
Exit Sub
10632
Resume 10631
End Sub
Sub Expand.Users
On Local Error Goto 10642
Number.UsersMax=Number.UsersMax+25
Redim Preserve UserArray(1 To Number.UsersMax) As UserType,_
UserIndex(1 To Number.UsersMax) As Integer
10641
Exit Sub
10642
Resume 10641
End Sub
Sub Valid.Name(Var$)
On Local Error Goto 10652
TempA=True
Var1$=Lcase$(Var$)
If Left$(Var1$,5)="login" Then
TempA=False
Endif
If Left$(Var1$,6)="logoff" Then
TempA=False
Endif
If Left$(Var1$,7)="relogin" Then
TempA=False
Endif
If Left$(Var1$,9)=Deleted$ Then
TempA=False
Endif
If Left$(Var1$,9)="<offline>" Then
TempA=False
Endif
10651
Exit Sub
10652
Resume 10651
End Sub
Sub Restrict(Var1)
On Local Error Goto 10662
TempB=False
If RoomRecord.Level>False Then
If UserRecord.Level<RoomRecord.Level Then
If RoomRecord.Restrictions And 2^Var1 Then
TempB=True
Endif
Endif
Endif
If RoomRecord.Level<False Then
If UserRecord.Level>Abs(RoomRecord.Level) Then
If RoomRecord.Restrictions And 2^Var1 Then
TempB=True
Endif
Endif
Endif
10661
Exit Sub
10662
Resume 10661
End Sub
Sub Valid(Var$,Var)
On Local Error Goto 10672
If Len(Var$)/2<>Len(Var$)\2 Then
Var$=Var$+" "
Endif
If Var/2<>Var\2 Then
Var=Var+1
Endif
Var$=Left$(Var$,Var)
Var$=Var$+Space$(Var-Len(Var$))
For Var1=1 To Var
Var2=Asc(Mid$(Var$,Var1,1))
If Var2<32 Or Var2>127 Then
Var$=Nul
Exit Sub
Endif
Next
10671
Exit Sub
10672
Resume 10671
End Sub
Sub Encrypt(Var$,Var)
On Local Error Goto 10682
Var1$=Nul
For Var2=1 To Len(Var$) Step 2
Var1=0
VarA=Asc(Mid$(Var$,Var2,1))
VarB=Asc(Mid$(Var$,Var2+1,1))
If Var Then
Var1=20000
Else
If (VarA+VarB)/2=(VarA+VarB)\2 Then
Var1=10000
Endif
Endif
Var1=Var1+(VarA-32)*100+(VarB-32)
Var1$=Var1$+Mki$(Var1)
Next
Var$=Var1$
10681
Exit Sub
10682
Resume 10681
End Sub
Sub Decrypt(Var$)
On Local Error Goto 10692
Var1$=Nul
For Var=1 To Len(Var$) Step 2
Var1=Cvi(Mid$(Var$,Var,2))
Var2=Var1\100
VarA=Var1-Var2*100
Var1=Var2
VarA=VarA+32
Var2=Var1\100
VarB=Var1-Var2*100
VarB=VarB+32
If Var2=0 Then
If ((VarA+VarB)/2)=((VarA+VarB)\2) Then
Var$=Nul
Exit Sub
Endif
Endif
If Var2=1 Then
If ((VarA+VarB)/2)<>((VarA+VarB)\2) Then
Var$=Nul
Exit Sub
Endif
Endif
Var1$=Var1$+Chr$(VarB)+Chr$(VarA)
Next
Var$=Var1$
10691
Exit Sub
10692
Resume 10691
End Sub
Sub Update.LogFile(Var$,VarX)
On Local Error Goto 10702
Close 13
Open Log.FileName For Random Shared As #13 Len=Len(LogRecord)
For Temp1=1 To Lof(13)/Len(LogRecord)
Get 13,Temp1,LogRecord
If LogRecord.User=False Then
Exit For
Endif
Next
VarX$=Var$+" on "+Mid$(FNclock$,5,9)+"!"
LogRecord.Message=VarX$
LogRecord.User=VarX
Put 13,Temp1,LogRecord
10701
Exit Sub
10702
Resume 10701
End Sub
Sub Update.LastUser
On Local Error Goto 10712
Close #13
Open LastUser.FileName For Append Shared As #13
Strng=UserRecord.CodeName
Call Decrypt(Strng)
Strng=Lcase$(Strng)
Mid$(Strng,1,1)=Ucase$(Mid$(Strng,1,1))
Out2=Mid$(Str$(Room),2)
Out2=Out2+Space$(5-Len(Out2))
Strng=Strng+Out2+" "+Time.On+" "+Time$
OnTime#=TimeValue#(Time$)-TimeValue#(Time.On)
If OnTime#<False Then
OnTime#=OnTime#+TimeValue#("12:00:00")*2
Endif
Temp$=FormatD$(OnTime#,"hh:mm:ss")
Strng=Strng+" "+Temp$
TempX!=Players.Killed*UserRecord.Level*2+Monsters.Killed*UserRecord.Level
If TempX!=False Then
Strng=Strng+" Zero"
Else
Strng=Strng+Str$(TempX!)
Endif
Print #13,Strng
Close #13
10711
Exit Sub
10712
Resume 10711
End Sub
Sub Last.User
On Local Error Goto 10722
Strng="(hit <control-k> to interrupt).."
Call IO.O
Graphics.Off=True
Strng="DNDBBS V"+Version$+" Last User List For "+Left$(FNclock$,13)+"."
Call IO.O
Strng=Nul
Call IO.O
Strng="# Username Room"
Strng=Strng+" Timeon Timeoff Total Score"
Call IO.O
Strng=String$(70,"-")
Call IO.O
Close #13
Open LastUser.FileName For Input Shared As #13
Redim Temp.ArrayS(1 To 5) As String
Temp1=False
Do While Not Eof(13)
Line Input #13,TempX$
Temp1=Temp1+1
If Temp1>5 Then
Temp1=5
For Temp2=1 To 4
Temp.ArrayS(Temp2)=Temp.ArrayS(Temp2+1)
Next
Endif
Temp.ArrayS(Temp1)=TempX$
Loop
Close #13
If Temp1>5 Then
Temp1=5
Endif
Allow.Break=True
For Temp2=1 To Temp1
Strng=Mid$(Str$(Temp2),2)+" "+Temp.ArrayS(Temp2)
Call IO.O
If Break Then
Exit For
Endif
Next
Allow.Break=False
Call More.Prompt
10721
Exit Sub
10722
Resume 10721
End Sub
Sub Whos.On
On Local Error Goto 10732
Strng="(hit <control-k> to interrupt).."
Call IO.O
Graphics.Off=True
Strng="DNDBBS V"+Version$+" Who Status Report For "+Left$(FNclock$,13)+"."
Call IO.O
Strng=Nul
Call IO.O
Strng="P# Username Timeon Room Score Classname"
Call IO.O
Strng=String$(68,"-")
Call IO.O
If Node=False Then
Strng=Mask$+Mask$
Out2=UserRecord.CodeName
Call Decrypt(Out2)
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Out2=Out2+Space$(30-Len(Out2))
Strng=Strng+" "+Out2+" "+Time.On
Out2=Mid$(Str$(Room),2)
Out2=Out2+Space$(5-Len(Out2))
Strng=Strng+" "+Out2
TempX!=Players.Killed*UserRecord.Level*2+Monsters.Killed*UserRecord.Level
If TempX!=False Then
Out2="Zero"
Else
Out2=Mid$(Str$(TempX!),2)
Endif
Out2=Out2+Space$(9-Len(Out2))
Strng=Strng+" "+Out2
Out2=UserRecord.ClassName
Call Decrypt(Out2)
Out2=Rtrim$(Out2)
Strng=Strng+" "+Out2
Call IO.O
Call More.Prompt
Exit Sub
Endif
Temp3=3
Allow.Break=True
For Temp5=1 To 36
Get 1,Temp5,MessWorkRecord1
If MessWorkRecord1.UserIndex>False Then
Out2=MessWorkRecord1.UserName
If Left$(Out2,9)<>"<offline>" Then
If Temp5<=10 Then
Strng="P"+Mid$(Str$(Temp5-1),2)
Else
Strng="P"+Chr$(Temp5+54)
Endif
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Strng=Strng+" "+Out2+" "+MessWorkRecord1.TimeOn
Out2=Mid$(Str$(MessWorkRecord1.RoomNumber),2)
Out2=Out2+Space$(5-Len(Out2))
Strng=Strng+" "+Out2
TempX!=MessWorkRecord1.Score1*UserRecord.Level*2+_
MessWorkRecord1.Score2*UserRecord.Level
Out2=Mid$(Str$(TempX!),2)
Out2=Out2+Space$(9-Len(Out2))
Strng=Strng+" "+Out2
Out2=MessWorkRecord1.ClassName
Out2=Rtrim$(Out2)
Strng=Strng+" "+Out2
Call IO.O
If Break Then
Exit For
Endif
Temp3=Temp3+1
If Temp3=21 Then
Temp3=False
Call More.Prompt
If No Then
Exit For
Endif
Endif
Endif
Endif
Next
Allow.Break=False
If Temp3>False Then
Call More.Prompt
Endif
10731
Exit Sub
10732
Resume 10731
End Sub