home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
d
/
dnd29c4.zip
/
SOURCE.ZIP
/
EDIT1.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-07
|
135KB
|
5,289 lines
Rem edit1.bas v2.9c
Rem $Include: 'dndbbs.inc'
Sub Search.Object
On Local Error Goto 10002
Do
Temp1$=Nul
Temp1=False
Temp3=False
Temp4=False
Temp6=False
Temp7=False
Temp8=False
Temp9=False
Temp10=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]object name substring"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]room link number"
If Temp1 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp1),2)+")"
Endif
Call IO.O
Strng="[C]key number"
If Temp3 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp3),2)+")"
Endif
Call IO.O
Strng="[D]invisible objects"
If Temp4 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[E]hidden objects"
If Temp6 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[F]trapped objects"
If Temp7 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[G]locked objects"
If Temp8 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[H]objects which relock"
If Temp9 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[I]nonpermanent objects"
If Temp10 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Object search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Object name substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp1$=Out2
Case "B"
Strng="Room link number?"
Call IO.I
Temp1=Int(Val(Out2))
Case "C"
Strng="Key number?"
Call IO.I
Temp3=Int(Val(Out2))
Case "D"
Temp4=True
Case "E"
Temp6=True
Case "F"
Temp7=True
Case "G"
Temp8=True
Case "H"
Temp9=True
Case "I"
Temp10=True
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(6)/Len(ObjectRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp5 Then
Temp2=Temp5
Endif
For Temp5=Temp To Temp2
Get 6,Temp5,ObjectRecord
TempX=False
If Temp1$<>Nul Then
If Instr(ObjectRecord.ObjectName,Temp1$) Then
TempX=True
Endif
Endif
If Temp1 Then
If ObjectRecord.RoomLink=Temp1 Then
TempX=True
Endif
Endif
If Temp3 Then
If ObjectRecord.Keyed=Temp3 Then
TempX=True
Endif
Endif
If Temp4 Then
If ObjectRecord.Invisible Then
TempX=True
Endif
Endif
If Temp6 Then
If ObjectRecord.Hidden Then
TempX=True
Endif
Endif
If Temp7 Then
If ObjectRecord.JailTrap Then
TempX=True
Endif
Endif
If Temp8 Then
If ObjectRecord.Closed Then
TempX=True
Endif
Endif
If Temp9 Then
If ObjectRecord.Relocks Then
TempX=True
Endif
Endif
If Temp10 Then
If ObjectRecord.Permanent=False Then
TempX=True
Endif
Endif
If TempX Then
Call Display.Object(False)
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10001
Exit Sub
10002
Resume 10001
End Sub
Sub Search.Monsters
On Local Error Goto 10012
Do
Temp1$=Nul
Temp1=False
Temp3=False
Temp4=False
Temp6=False
Temp7=False
Temp8=False
Temp9=False
Temp10=False
Temp11=False
Temp12=False
Temp13=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]monster name substring"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]monster level"
If Temp1 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp1),2)+")"
Endif
Call IO.O
Strng="[C]hit points"
If Temp3>False And Temp4>False Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp3),2)+"-"+Mid$(Str$(Temp4),2)+")"
Endif
Call IO.O
Strng="[D]experience"
If Temp6>False And Temp7>False Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp6),2)+"-"+Mid$(Str$(Temp7),2)+")"
Endif
Call IO.O
Strng="[E]poisons"
If Temp8 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[F]drains levels"
If Temp9 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[G]casts spells"
If Temp10 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[H]jails attacker"
If Temp11 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[I]psionic monsters"
If Temp12 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[J]equation"
If Temp13 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Monster search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Monster name substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp1$=Out2
Case "B"
Strng="Monster level?"
Call IO.I
Temp1=Int(Val(Out2))
Case "C"
Strng="Enter range:"
Call IO.O
No.Input.Out="1"
Strng="From?"
Call IO.I
Temp3=Int(Val(Out2))
No.Input.Out="10"
Strng="To?"
Call IO.I
Temp4=Int(Val(Out2))
Case "D"
Strng="Enter range:"
Call IO.O
No.Input.Out="1"
Strng="From?"
Call IO.I
Temp6=Int(Val(Out2))
No.Input.Out="10"
Strng="To?"
Call IO.I
Temp7=Int(Val(Out2))
Case "E"
Temp8=True
Case "F"
Temp9=True
Case "G"
Temp10=True
Case "H"
Temp11=True
Case "I"
Temp12=True
Case "J"
Temp13=True
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(7)/Len(MonsterRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp5 Then
Temp2=Temp5
Endif
For Temp5=Temp To Temp2
TempX=False
Get 7,Temp5,MonsterRecord
If Temp1$<>Nul Then
If Instr(MonsterRecord.MonsterName,Temp1$) Then
TempX=True
Endif
Endif
If Temp1 Then
If MonsterRecord.Level=Temp1 Then
TempX=True
Endif
Endif
If Temp3 And Temp4 Then
If MonsterRecord.Hits>=Temp3 And_
MonsterRecord.Hits<=Temp4 Then
TempX=True
Endif
Endif
If Temp6 And Temp7 Then
If MonsterRecord.Experience>=Temp6 And_
MonsterRecord.Experience<=Temp7 Then
TempX=True
Endif
Endif
If Temp8 Then
If MonsterRecord.Poison Then
TempX=True
Endif
Endif
If Temp9 Then
If MonsterRecord.LevelDrain Then
TempX=True
Endif
Endif
If Temp10 Then
If MonsterRecord.Spell Then
TempX=True
Endif
Endif
If Temp11 Then
If MonsterRecord.Jail Then
TempX=True
Endif
Endif
If Temp12 Then
If MonsterRecord.Psionic Then
TempX=True
Endif
Endif
If Temp13 Then
If MonsterRecord.Equation Then
TempX=True
Endif
Endif
If TempX Then
Call Display.Monster(False)
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10011
Exit Sub
10012
Resume 10011
End Sub
Sub Search.Nonplayers
On Local Error Goto 10022
Do
Temp1$=Nul
Temp1=False
Temp3=False
Temp4=False
Temp6=False
Temp7=False
Temp8=False
Temp9=False
Temp10=False
Temp11=False
Temp12=False
Temp13=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]nonplayer name substring"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]nonplayer level"
If Temp1 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp1),2)+")"
Endif
Call IO.O
Strng="[C]hit points"
If Temp3>False And Temp4>False Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp3),2)+"-"+Mid$(Str$(Temp4),2)+")"
Endif
Call IO.O
Strng="[D]experience"
If Temp6>False And Temp7>False Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp6),2)+"-"+Mid$(Str$(Temp7),2)+")"
Endif
Call IO.O
Strng="[E]poisons"
If Temp8 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[F]drains levels"
If Temp9 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[G]casts spells"
If Temp10 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[H]jails attacker"
If Temp11 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[I]psionic nonplayers"
If Temp12 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[J]equation"
If Temp13 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Nonplayer search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Nonplayer name substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp1$=Out2
Case "B"
Strng="Nonplayer level?"
Call IO.I
Temp1=Int(Val(Out2))
Case "C"
Strng="Enter range:"
Call IO.O
No.Input.Out="1"
Strng="From?"
Call IO.I
Temp3=Int(Val(Out2))
No.Input.Out="10"
Strng="To?"
Call IO.I
Temp4=Int(Val(Out2))
Case "D"
Strng="Enter range:"
Call IO.O
No.Input.Out="1"
Strng="From?"
Call IO.I
Temp6=Int(Val(Out2))
No.Input.Out="10"
Strng="To?"
Call IO.I
Temp7=Int(Val(Out2))
Case "E"
Temp8=True
Case "F"
Temp9=True
Case "G"
Temp10=True
Case "H"
Temp11=True
Case "I"
Temp12=True
Case "J"
Temp13=True
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(9)/Len(MonsterRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp5 Then
Temp2=Temp5
Endif
For Temp5=Temp To Temp2
TempX=False
Get 9,Temp5,MonsterRecord
If Temp1$<>Nul Then
If Instr(MonsterRecord.MonsterName,Temp1$) Then
TempX=True
Endif
Endif
If Temp1 Then
If MonsterRecord.Level=Temp1 Then
TempX=True
Endif
Endif
If Temp3 And Temp4 Then
If MonsterRecord.Hits>=Temp3 And_
MonsterRecord.Hits<=Temp4 Then
TempX=True
Endif
Endif
If Temp6 And Temp7 Then
If MonsterRecord.Experience>=Temp6 And_
MonsterRecord.Experience<=Temp7 Then
TempX=True
Endif
Endif
If Temp8 Then
If MonsterRecord.Poison Then
TempX=True
Endif
Endif
If Temp9 Then
If MonsterRecord.LevelDrain Then
TempX=True
Endif
Endif
If Temp10 Then
If MonsterRecord.Spell Then
TempX=True
Endif
Endif
If Temp11 Then
If MonsterRecord.Jail Then
TempX=True
Endif
Endif
If Temp12 Then
If MonsterRecord.Psionic Then
TempX=True
Endif
Endif
If Temp13 Then
If MonsterRecord.Equation Then
TempX=True
Endif
Endif
If TempX Then
Call Display.Nonplayer(False)
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10021
Exit Sub
10022
Resume 10021
End Sub
Sub Search.Spells
On Local Error Goto 10032
Do
Temp1$=Nul
Temp2$=Nul
Temp3=False
Temp4=False
Temp6=False
Temp7=False
Temp8=False
Temp9=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]spell name substring"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]chant substring"
If Temp2$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp2$+")"
Endif
Call IO.O
Strng="[C]spell level"
If Temp3 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[D]psionic spells"
If Temp4 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[E]spell type"
If Temp6 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(Type:"+Str$(Temp6)+")"
Endif
Call IO.O
Strng="[F]requires ingredients"
If Temp7 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[G]casting type"
If Temp8 Then
Strng=Strng+Space$(30-Len(Strng))
Select Case Temp8
Case 1
Strng=Strng+"(use)"
Case 2
Strng=Strng+"(read)"
Case 3
Strng=Strng+"(cast)"
End Select
Endif
Call IO.O
Strng="[H]equation"
If Temp9 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Spell search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Spell name substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp1$=Out2
Case "B"
Strng="Chant substring?"
Call IO.I
Out2=Ucase$(Out2)
Temp2$=Out2
Case "C"
Strng="Spell level?"
Call IO.I
Temp3=Int(Val(Out2))
Case "D"
Temp4=True
Case "E"
Call Spell.Types
Strng="Spell type?"
Line.Length=TempD
No.Input.Out="A"
Call IO.I
Out2=Ucase$(Out2)
Temp6=Instr("ABCDEFGHIJKLMNOPRSTUVWXYZ123",Out2)
Case "F"
Temp7=True
Case "G"
Graphics.Off=True
Strng="[1]use command"
Call IO.O
Strng="[2]read scroll"
Call IO.O
Strng="[3]cast spell"
Call IO.O
Graphics.Off=False
Line.Length=TempD
Strng="Casting type("+Enter$+"=none)?"
Call IO.I
Select Case Int(Val(Out2))
Case 1
Temp8=Use.Spell.Type
Case 2
Temp8=Scroll.Spell.Type
Case 3
Temp8=Cast.Spell.Type
Case Else
Temp8=False
End Select
Case "H"
Temp9=True
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(4)/Len(SpellRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp5 Then
Temp2=Temp5
Endif
For Temp5=Temp To Temp2
TempX=False
Get 4,Temp5,SpellRecord
If Temp1$<>Nul Then
If Instr(SpellRecord.SpellName,Temp1$) Then
TempX=True
Endif
Endif
If Temp2$<>Nul Then
If Instr(SpellRecord.Chant,Temp2$) Then
TempX=True
Endif
Endif
If Temp3 Then
If SpellRecord.Level=Temp3 Then
TempX=True
Endif
Endif
If Temp4 Then
If SpellRecord.Psionic Then
TempX=True
Endif
Endif
If Temp6 Then
If SpellRecord.SpellType=Temp6 Then
TempX=True
Endif
Endif
If Temp7 Then
For TempY=1 To 5
If SpellRecord.Ingred(TempY)>False Then
TempX=True
Exit For
Endif
Next
Endif
If Temp8 Then
If SpellRecord.SpellFlag And Temp8 Then
TempX=True
Endif
Endif
If Temp9 Then
If SpellRecord.Equation=True Then
TempX=True
Endif
Endif
If TempX Then
Call Display.Spell(False)
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10031
Exit Sub
10032
Resume 10031
End Sub
Sub Search.Treasure
On Local Error Goto 10042
Do
Temp1$=Nul
Temp1=False
Temp3=False
Temp4=False
Temp6=False
Temp7=False
Temp8=False
Temp9=False
Temp10=False
Temp11=False
Temp12=False
Temp13=False
Temp14=False
Temp15=False
Temp16=False
Temp17=False
Temp18=False
Temp19=False
Temp20=False
Temp21=False
Temp22=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]treasure name substring"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]weight"
If Temp1>False And Temp2>False Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp1),2)+"-"+Mid$(Str$(Temp2),2)+")"
Endif
Call IO.O
Strng="[C]value"
If Temp4>False And Temp6>False Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp4),2)+"-"+Mid$(Str$(Temp6),2)+")"
Endif
Call IO.O
Strng="[D]hit plus"
If Temp7 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp7),2)+")"
Endif
Call IO.O
Strng="[E]strikes"
If Temp8 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp7),2)+")"
Endif
Call IO.O
Strng="[F]coins"
If Temp11 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[G]potions"
If Temp12 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[H]scrolls"
If Temp13 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[I]loadable"
If Temp14 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[J]ammunition"
If Temp15 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[K]receptacles"
If Temp16 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[L]key number"
If Temp9 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp9),2)+")"
Endif
Call IO.O
Strng="[M]spell name"
If Temp10 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(number:"+Str$(Temp10)+")"
Endif
Call IO.O
Strng="[N]rings"
If Temp17 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[O]rustable"
If Temp18 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[P]stealable"
If Temp19 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[R]edible"
If Temp20 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[T]launchable
If Temp21 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Strng="[U]launch ammo"
If Temp22 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(selected)"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Treasure search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Treasure name substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp1$=Out2
Case "B"
Strng="Enter range:"
Call IO.O
Strng="From?"
No.Input.Out="1"
Call IO.I
Temp1=Int(Val(Out2))
Strng="To?"
No.Input.Out="10"
Call IO.I
Temp3=Int(Val(Out2))
Case "C"
Strng="Enter range:"
Call IO.O
Strng="From?"
No.Input.Out="1"
Call IO.I
Temp4=Int(Val(Out2))
Strng="To?"
No.Input.Out="10"
Call IO.I
Temp6=Int(Val(Out2))
Case "D"
Strng="Hit plus?"
Call IO.I
Temp7=Int(Val(Out2))
Case "E"
Strng="Charges?"
Call IO.I
Temp8=Int(Val(Out2))
Case "F"
Temp11=True
Case "G"
Temp12=True
Case "H"
Temp13=True
Case "I"
Temp14=True
Case "J"
Temp15=True
Case "K"
Temp16=True
Case "L"
Strng="Key number?"
Call IO.I
Temp9=Int(Val(Out2))
Case "M"
Call Find.Spell
If Temp Then
Temp10=Temp
Endif
Case "N"
Temp17=True
Case "O"
Temp18=True
Case "P"
Temp19=True
Case "R"
Temp20=True
Case "T"
Temp21=True
Case "U"
Temp22=True
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(8)/Len(TreasureRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp5 Then
Temp2=Temp5
Endif
For Temp5=Temp To Temp2
TempX=False
Get 8,Temp5,TreasureRecord
If Temp1$<>Nul Then
If Instr(TreasureRecord.TreasureName,Temp1$) Then
TempX=True
Endif
Endif
If Temp1 And Temp3 Then
If TreasureRecord.Weight>=Temp1 And_
TreasureRecord.Weight<=Temp3 Then
TempX=True
Endif
Endif
If Temp4 And Temp6 Then
If TreasureRecord.Gold>=Temp4 And_
TreasureRecord.Gold<=Temp6 Then
TempX=True
Endif
Endif
If Temp7 Then
If Abs(TreasureRecord.Plus)=Temp7 Then
TempX=True
Endif
Endif
If Temp8 Then
If Abs(TreasureRecord.Charges)=Temp8 Then
TempX=True
Endif
Endif
If Temp9 Then
If TreasureRecord.Keyed=Temp9 Then
TempX=True
Endif
Endif
If Temp10 Then
If TreasureRecord.Spell=Temp10 Then
TempX=True
Endif
Endif
If Temp11 Then
If TreasureRecord.Coin Then
TempX=True
Endif
Endif
If Temp12 Then
If TreasureRecord.Potion Then
TempX=True
Endif
Endif
If Temp13 Then
If TreasureRecord.Scroll Then
TempX=True
Endif
Endif
If Temp14 Then
If TreasureRecord.Loadable Then
TempX=True
Endif
Endif
If Temp15 Then
If TreasureRecord.Ammunition Then
TempX=True
Endif
Endif
If Temp16 Then
If TreasureRecord.Recep Then
TempX=True
Endif
Endif
If Temp17 Then
If TreasureRecord.RingType Then
TempX=True
Endif
Endif
If Temp18 Then
If TreasureRecord.Rustable Then
TempX=True
Endif
Endif
If Temp19 Then
If TreasureRecord.Stealable Then
TempX=True
Endif
Endif
If Temp20 Then
If TreasureRecord.Edible Then
TempX=True
Endif
Endif
If Temp21 Then
If TreasureRecord.Launchable Then
TempX=True
Endif
Endif
If Temp22 Then
If TreasureRecord.LaunchAmmo Then
TempX=True
Endif
Endif
If TempX Then
Call Display.Treasure(False)
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10041
Exit Sub
10042
Resume 10041
End Sub
Sub Search.Description
On Local Error Goto 10052
Do
Temp1$=Nul
Temp2$=Nul
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]long description"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]short description"
If Temp2$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp2$+")"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Description search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Long description substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp1$=Out2
Case "B"
Strng="Short description substring?"
Call IO.I
Out2=Lcase$(Out2)
Temp2$=Out2
Case "S"
Strng="Enter range:"
Call IO.O
Temp3=Lof(5)/Len(RoomRecord)
Temp$=Mid$(Str$(Temp3),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp3 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp3 Then
Temp2=Temp3
Endif
For Temp5=Temp To Temp2
TempX=False
Get 5,Temp5,RoomRecord
If Temp1$<>Nul Then
For Temp3=1 To 4
Out3=Lcase$(RoomRecord.LongDesc(Temp3))
If Instr(Out3,Temp1$) Then
TempX=True
Exit For
Endif
Next
Endif
If Temp2$<>Nul Then
Out3=Lcase$(RoomRecord.ShortDesc)
If Instr(Out3,Temp2$) Then
TempX=True
Endif
Endif
If TempX Then
Call Display.Room
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10051
Exit Sub
10052
Resume 10051
End Sub
Sub Add.User
On Local Error Goto 10062
Temp4=Lof(3)/Len(UserRecord)+1
Strng=Deleted$
Call Valid(Strng,30)
Call Encrypt(Strng,True)
UserRecord.CodeName=Strng
Strng=Deleted$
Call Valid(Strng,20)
Call Encrypt(Strng,False)
UserRecord.PassWord=Strng
Strng=Deleted$
Call Valid(Strng,20)
Call Encrypt(Strng,True)
UserRecord.ClassName=Strng
UserRecord.ClassType=False
For Temp6=1 To 7
UserRecord.Stats(Temp6)=False
Next
For Temp6=1 To 4
UserRecord.Weapons(Temp6)=False
Next
UserRecord.Room=False
UserRecord.Level=False
UserRecord.Experience=False
UserRecord.Gold=False
UserRecord.Borrow=False
UserRecord.NumCalls=False
UserRecord.Fatigue=False
UserRecord.FatigueMax=False
UserRecord.Vitality=False
UserRecord.VitalityMax=False
UserRecord.Magic=False
UserRecord.MagicMax=False
UserRecord.Psionic=False
UserRecord.PsionicMax=False
UserRecord.Poison=False
UserRecord.Invisible=False
UserRecord.Race=False
UserRecord.Proficiency=False
UserRecord.Bank=False
UserRecord.PlayersKilled=False
UserRecord.MonstersKilled=False
UserRecord.Brief=False
Strng=Date$
Call Valid(Strng,10)
Call Encrypt(Strng,True)
UserRecord.DateOn=Strng
UserRecord.Align1=False
UserRecord.Align2=False
UserRecord.Flags=False
UserRecord.MaxCalls=False
UserRecord.FromHour=False
UserRecord.FromMin=False
UserRecord.ToHour=False
UserRecord.ToMin=False
Put 3,Temp4,UserRecord
10061
Exit Sub
10062
Resume 10061
End Sub
Sub Edit.User
On Local Error Goto 10072
If Lof(3)=False Then
Call Add.User
Endif
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd"
Call IO.O
Strng="[C]hange"
Call IO.O
Strng="[L]ist"
Call IO.O
Strng="[P]ack"
Call IO.O
Strng="[S]earch"
Call IO.O
Graphics.Off=False
Endif
Strng="User edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Add.User
Case "C"
Call Change.User
Case "L"
Call List.User
Case "P"
Call Pack.Users
Case "S"
Call Search.Users
Case "Q"
Exit Sub
End Select
Loop
10071
Exit Sub
10072
Resume 10071
End Sub
Sub List.User
On Local Error Goto 10082
Do
Graphics.Off=True
If TempC=False Then
Strng="[D]ayfile"
Call IO.O
Strng="[L]ist"
Call IO.O
Strng="[T]op ten"
Call IO.O
Strng="[U]sers"
Call IO.O
Graphics.Off=False
Endif
Strng="User list option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "D"
Call Read.Dayfile
Case "L"
Call Show.Users
Case "T"
Call Top.Ten
Case "U"
Call User.Report
Case "Q"
Exit Sub
End Select
Loop
10081
Exit Sub
10082
Resume 10081
End Sub
Sub User.Report
On Local Error Goto 10092
Graphics.Off=True
Strng="DNDBBS V"+Version$+" User List For "+FNclock$+"."
Call IO.O
Strng=Nul
Call IO.O
Strng="Number User Name Class Name"
Strng=Strng+" Race Level"
Call IO.O
Strng=String$(73,"-")
Call IO.O
Temp5=4
Allow.Break=True
For Temp3=1 To Lof(3)/Len(UserRecord)
Get 3,Temp3,UserRecord
Strng=UserRecord.CodeName
Call Decrypt(Strng)
If Left$(Strng,9)<>Deleted$ Then
Strng=Mid$(Str$(Temp3),2)+"."
Strng=Strng+Space$(7-Len(Strng))
Out2=UserRecord.CodeName
Call Decrypt(Out2)
Strng=Strng+Out2+" "
Out2=UserRecord.ClassName
Call Decrypt(Out2)
Strng=Strng+Out2+" "
If UserRecord.Race<1 Then
UserRecord.Race=1
Endif
Out2=Race(UserRecord.Race)
Out2=Rtrim$(Out2)
Out2=Out2+Space$(8-Len(Out2))
Strng=Strng+Out2
If UserRecord.Level<1 Then
Out2=" -dead-"
Else
Out2=Str$(UserRecord.Level)
Endif
Out2=Out2+Space$(7-Len(Out2))
If UserRecord.Flags And Locked.User Then
Out2=Out2+Mask$
Endif
If UserRecord.ClassType>8 Then
Out2=Out2+"*"
Endif
Strng=Strng+Out2
Call IO.O
If Break Then
Exit For
Endif
Temp5=Temp5+1
If Temp5=23 Then
Temp5=False
Call More.Prompt
If No Then
Exit For
Endif
Endif
Endif
Next
If Temp5 Then
Call More.Prompt
Endif
Allow.Break=False
10091
Exit Sub
10092
Resume 10091
End Sub
Sub Read.DayFile
On Local Error Goto 10102
Close 13
Temp5=False
Graphics.Off=True
Allow.Break=True
Open Day.File.FileName 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
Temp5=Temp5+1
If Temp5=23 Then
Temp5=False
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Loop
Allow.Break=False
If Temp5 Then
Call More.Prompt
Endif
10101
Exit Sub
10102
Resume 10101
End Sub
Sub Change.User
On Local Error Goto 10112
Graphics.Off=False
Strng="User name, or number?"
No.Input.Out="1"
Call IO.I
Temp7=False
Out2=Ucase$(Out2)
If Instr(Out2,"#") Then
Temp7=Val(Mid$(Out2,Instr(Out2,"#")+1))
Out2=Left$(Out2,Instr(Out2,"#")-1)
Endif
TempX=False
No.Input=False
Temp4=Len(Out2)
For Temp5=1 To Lof(3)/Len(UserRecord)
Get 3,Temp5,UserRecord
Out3=UserRecord.CodeName
Call Decrypt(Out3)
If Left$(Out3,Temp4)=Out2 Then
TempX=TempX+1
If Temp7=False Or TempX=Temp7 Then
No.Input=True
Exit For
Endif
Endif
Next
If No.Input=False Then
Temp5=Int(Val(Out2))
If Temp5>False And Temp5<=Lof(3)/Len(UserRecord) Then
No.Input=True
Endif
Endif
If No.Input=False Then
Strng="User name not found."
Call IO.O
Exit Sub
Endif
Get 3,Temp5,UserRecord
Out3=UserRecord.CodeName
Call Decrypt(Out3)
If Left$(Out3,9)=Deleted$ Then
Strng="Deleted user record."
Call IO.O
Exit Sub
Endif
Call Modify.User
10111
Exit Sub
10112
Resume 10111
End Sub
Sub Show.Users
On Local Error Goto 10122
Strng="Enter range:"
Call IO.O
Temp3=Lof(3)/Len(UserRecord)
Temp$=Mid$(Str$(Temp3),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Sub
Endif
If Temp2>Temp3 Then
Temp2=Temp3
Endif
For Temp5=Temp To Temp2
Get 3,Temp5,UserRecord
Out3=UserRecord.CodeName
Call Decrypt(Out3)
If Left$(Out3,9)<>Deleted$ Then
Call Display.User(False)
Call More.Prompt
If No Then
Exit For
Endif
Endif
Next
10121
Exit Sub
10122
Resume 10121
End Sub
Sub Display.User(TempX)
On Local Error Goto 10132
If TempX Then
If TempC Then
Exit Sub
Endif
Endif
Graphics.Off=True
Strng="User number"+Str$(Temp5)+"."
Call IO.O
Strng=""
If TempX Then
Strng="[A]"
Endif
Out2=UserRecord.CodeName
Call Decrypt(Out2)
Out2=Rtrim$(Out2)
Strng=Strng+"Username: "+Out2+" "
If Local.Mode=False And Config2(81)=False Then
Out2=String$(10,Mask$)
Else
Out2=UserRecord.PassWord
Call Decrypt(Out2)
Out2=Rtrim$(Out2)
Endif
If TempX Then
Strng=Strng+"[B]"
Endif
Strng=Strng+"Password: "+Out2
Call IO.O
Strng=""
If TempX Then
Strng="[C]"
Endif
Strng=Strng+"Level:"+Str$(UserRecord.Level)
Call IO.O
Strng=""
If TempX Then
Strng="[D]"
Endif
Strng=Strng+"Class: "+Rtrim$(Class.Name(UserRecord.ClassType))
Call IO.O
Strng=""
If TempX Then
Strng="[E]"
Endif
Strng=Strng+"Weapon proficiency: "+_
Rtrim$(Weapon.Type.Name(UserRecord.Proficiency))
Call IO.O
Strng=""
If TempX Then
Strng="[F]"
Endif
Strng=Strng+"Blunt proficiency%:"+Str$(UserRecord.Weapons(1))
Call IO.O
Strng=""
If TempX Then
Strng="[G]"
Endif
Strng=Strng+"Pole proficiency%:"+Str$(UserRecord.Weapons(2))
Call IO.O
Strng=""
If TempX Then
Strng="[H]"
Endif
Strng=Strng+"Sharp proficiency%:"+Str$(UserRecord.Weapons(3))
Call IO.O
Strng=""
If TempX Then
Strng="[I]"
Endif
Strng=Strng+"Thrusting proficiency%:"+Str$(UserRecord.Weapons(4))
Call IO.O
Strng=""
If TempX Then
Strng="[J]"
Endif
Strng=Strng+"Classname: "
Out2=UserRecord.ClassName
Call Decrypt(Out2)
Out2=Rtrim$(Out2)
Strng=Strng+Out2
Call IO.O
Strng=""
If TempX Then
Strng="[K]"
Endif
Strng=Strng+"Strength:"+Str$(UserRecord.Stats(1))
Call IO.O
Strng=""
If TempX Then
Strng="[L]"
Endif
Strng=Strng+"Intelligence:"+Str$(UserRecord.Stats(2))
Call IO.O
Strng=""
If TempX Then
Strng="[M]"
Endif
Strng=Strng+"Wisdom:"+Str$(UserRecord.Stats(3))
Call IO.O
Strng=""
If TempX Then
Strng="[N]"
Endif
Strng=Strng+"Dexterity:"+Str$(UserRecord.Stats(4))
Call IO.O
Strng=""
If TempX Then
Strng="[O]"
Endif
Strng=Strng+"Constitution:"+Str$(UserRecord.Stats(5))
Call IO.O
Strng=""
If TempX Then
Strng="[P]"
Endif
Strng=Strng+"Piety:"+Str$(UserRecord.Stats(6))
Call IO.O
Strng=""
If TempX Then
Strng="[R]"
Endif
Strng=Strng+"Charisma:"+Str$(UserRecord.Stats(7))
Call IO.O
Strng=""
If TempX Then
Strng="[S]"
Endif
Strng=Strng+"Experience:"+Str$(UserRecord.Experience)
Call IO.O
Strng=""
If TempX Then
Strng="[T]"
Endif
Strng=Strng+"Gold:"+Str$(UserRecord.Gold)
Call IO.O
Strng=""
If TempX Then
Strng="[U]"
Endif
Strng=Strng+"Room number:"+Str$(UserRecord.Room)
Call IO.O
Strng=""
If TempX Then
Strng="[V]Call restrictions."
Call IO.O
Strng="[W]Inventory."
Call IO.O
Endif
Strng=""
If TempX Then
Strng="[X]"
Endif
Strng=Strng+"Special characters: "
Temp=False
If UserRecord.Flags And Special.Char1 Then
Strng=Strng+"town mayor, "
Temp=True
Endif
If UserRecord.Flags And Special.Char2 Then
Strng=Strng+"governor, "
Temp=True
Endif
If UserRecord.Flags And Special.Char3 Then
Strng=Strng+"guild master, "
Temp=True
Endif
If UserRecord.Flags And Special.Char4 Then
Strng=Strng+"sysop, "
Temp=True
Endif
If Temp Then
Strng=Left$(Strng,Len(Strng)-2)+"."
Else
Strng=Strng+"none."
Endif
Call IO.O
If TempX Then
Strng="[!]delete User"
Call IO.O
Endif
Graphics.Off=False
10131
Exit Sub
10132
Resume 10131
End Sub
Sub Modify.User
On Local Error Goto 10142
Do
Call Display.User(True)
Graphics.Off=False
Strng="User change option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
If Local.Mode=False And Config2(81)=False Then
Strng="Remote DMs cannot edit username."
Call IO.O
Else
Strng="Username?"
No.Input.Out=Deleted$
Call IO.I
Out2=Ucase$(Out2)
Call Valid(Out2,30)
If Out2=Nul Then
Strng="Illegal characters in codename."
Call IO.O
Else
Call Encrypt(Out2,True)
UserRecord.CodeName=Out2
Endif
Endif
Case "B"
If Local.Mode=False And Config2(81)=False Then
Strng="Remote DMs cannot edit password."
Call IO.O
Else
Out2=UserRecord.PassWord
Call Decrypt(Out2)
If Out2=Nul Then
Strng="This password has a checksum error."
Call IO.O
Endif
Strng="Password?"
No.Input.Out=Deleted$
Call IO.I
Out2=Ucase$(Out2)
Call Valid(Out2,20)
If Out2=Nul Then
Strng="Illegal characters in password."
Call IO.O
Else
Call Encrypt(Out2,False)
UserRecord.PassWord=Out2
Endif
Endif
Case "C"
Strng="Level?"
No.Input.Out="1"
Call IO.I
Temp3=Int(Val(Out2))
UserRecord.Level=Temp3
If Temp3>9999 Then
Strng="User has dungeon master access."
Call IO.O
Else
If Temp3>999 Then
Strng="User has assistant dungeon master access."
Call IO.O
Endif
Endif
Call New.Stats
Case "D"
Do
Graphics.Off=True
If TempC=False Then
For Temp3=1 To 9
Strng="["+Chr$(64+Temp3)+"]"+Rtrim$(Class.Name(Temp3))
Call IO.O
Next
If Local.Mode Then
Strng="[J]"+Rtrim$(Class.Name(10))
Call IO.O
Endif
Graphics.Off=False
Endif
Strng="Class option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Temp$=Ucase$(Out2)
Select Case Temp$
Case "A" To "I"
UserRecord.ClassType=(Asc(Temp$)-64)
Call New.Stats
Case "J"
If Local.Mode Then
UserRecord.ClassType=10
Call New.Stats
Endif
Case "Q"
Exit Do
End Select
Loop
Case "E"
Do
Graphics.Off=True
If TempC=False Then
For Temp3=1 To 4
Strng="["+Chr$(64+Temp3)+"]"+_
Rtrim$(Weapon.Type.Name(Temp3))
Call IO.O
Next
Graphics.Off=False
Endif
Strng="Weapon proficiency(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Temp$=Ucase$(Out2)
Select Case Temp$
Case "A" To "D"
UserRecord.Proficiency=(Asc(Temp$)-64)
Case "Q"
Exit Do
End Select
Loop
Case "F"
Strng="Blunt weapon proficiency%(1-100)?"
No.Input.Out="10"
Call IO.I
UserRecord.Weapons(1)=Int(Val(Out2))
Case "G"
Strng="Pole weapon proficiency%(1-100)?"
No.Input.Out="10"
Call IO.I
UserRecord.Weapons(2)=Int(Val(Out2))
Case "H"
Strng="Sharp weapon proficiency%(1-100)?"
No.Input.Out="10"
Call IO.I
UserRecord.Weapons(3)=Int(Val(Out2))
Case "I"
Strng="Thrusting weapon proficiency%(1-100)?"
No.Input.Out="10"
Call IO.I
UserRecord.Weapons(4)=Int(Val(Out2))
Case "J"
Strng="Classname?"
No.Input.Out=Deleted$
Call IO.I
Call Valid(Out2,20)
If Out2=Nul Then
Strng="Illegal characters in classname."
Call IO.O
Else
Call Encrypt(Out2,True)
UserRecord.ClassName=Out2
Endif
Case "K"
Strng="Strength?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(1)=Int(Val(Out2))
Case "L"
Strng="Intelligence?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(2)=Int(Val(Out2))
Case "M"
Strng="Wisdom?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(3)=Int(Val(Out2))
Case "N"
Strng="Dexterity?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(4)=Int(Val(Out2))
Case "O"
Strng="Constitution?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(5)=Int(Val(Out2))
Case "P"
Strng="Piety?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(6)=Int(Val(Out2))
Case "R"
Strng="Charisma?"
No.Input.Out=Mid$(Str$(Config1(4)),2)
Call IO.I
UserRecord.Stats(7)=Int(Val(Out2))
Case "S"
Strng="Experience?"
No.Input.Out="128"
Call IO.I
UserRecord.Experience=Val(Out2)
Case "T"
Strng="Gold?"
No.Input.Out=Mid$(Str$(Config2(32)),2)
Call IO.I
UserRecord.Gold=Val(Out2)
Case "U"
Strng="Room number?"
No.Input.Out=Mid$(Str$(Val(Config3(24))),2)
Call IO.I
UserRecord.Room=Int(Val(Out2))
Case "V"
Graphics.Off=True
Strng="Calls made today?"
No.Input.Out="0"
Call IO.I
UserRecord.NumCalls=Int(Val(Out2))
Strng="Maximum calls per day?"
No.Input.Out=Mid$(Str$(Config2(1)),2)
Call IO.I
UserRecord.MaxCalls=Int(Val(Out2))
Strng="Timeon restriction(from hour: form HH)?"
No.Input.Out="00"
Call IO.I
UserRecord.FromHour=Int(Val(Out2))
Strng="Timeon restriction(from minute: form MM)?"
No.Input.Out="00"
Call IO.I
UserRecord.FromMin=Int(Val(Out2))
Strng="Timeon restriction(to hour: form HH)?"
No.Input.Out="00"
Call IO.I
UserRecord.ToHour=Int(Val(Out2))
Strng="Timeon restriction(to minute: form MM)?"
No.Input.Out="00"
Call IO.I
UserRecord.ToMin=Int(Val(Out2))
Graphics.Off=False
Case "W"
Call Edit.Inventory
Case "X"
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]town mayor"
Call IO.O
Strng="[B]governor"
Call IO.O
Strng="[C]guild master"
Call IO.O
Strng="[D]sysop"
Call IO.O
Strng="[E]none"
Call IO.O
Graphics.Off=False
Endif
Strng="Special class option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
UserRecord.Flags=UserRecord.Flags Or Special.Char1
Strng="User is now town mayor."
Call IO.O
Case "B"
UserRecord.Flags=UserRecord.Flags Or Special.Char2
Strng="User is now governor."
Call IO.O
Case "C"
UserRecord.Flags=UserRecord.Flags Or Special.Char3
Strng="User is now guild master."
Call IO.O
Case "D"
UserRecord.Flags=UserRecord.Flags Or Special.Char4
Strng="User is now sysop."
Call IO.O
Case "E"
UserRecord.Flags=UserRecord.Flags And Not Special.Char1
UserRecord.Flags=UserRecord.Flags And Not Special.Char2
UserRecord.Flags=UserRecord.Flags And Not Special.Char3
UserRecord.Flags=UserRecord.Flags And Not Special.Char4
Strng="User is cleared of special character class."
Call IO.O
Case "Q"
Exit Do
End Select
Loop
Case "!"
Strng="Are you sure(y/n)?"
Line.Length=TempD
No.Input.Out="N"
Call IO.I
If Yes Then
Call Delete.User
Strng="User deleted."
Call IO.O
Exit Do
Endif
Case "Q"
Exit Do
End Select
Loop
Put 3,Temp5,UserRecord
10141
Exit Sub
10142
Resume 10141
End Sub
Sub Pack.Users
On Local Error Goto 10152
Strng="Delete -dead- users(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
TempX=False
If Yes Then
TempX=True
Endif
TempZ=False
Strng="Delete users before date(y/n)?"
Line.Length=TempD
No.Input.Out="N"
Call IO.I
If Yes Then
TempZ=True
Strng="Enter date:"
No.Input.Out="01-01-1980"
Call IO.I
Temp#=Int(DateValue#(Out2))
Endif
Graphics.Off=True
Strng="Making backup of userfile.."
Call IO.O
Close 13
FileName=Config3(11)+Config3(21)+".BAK"
Open FileName For Random Shared As #13 Len=Len(UserRecord)
Strng="User record copied:"+Space$(5)
Carriage.Return=True
Call IO.O
For Temp3=1 To Lof(3)/Len(UserRecord)
Get 3,Temp3,UserRecord
Put 13,Temp3,UserRecord
For Temp5=1 To 5
Call Back.Space
Next
Strng=Str$(Temp3)
Strng=Strng+Space$(5-Len(Strng))
Carriage.Return=True
Call IO.O
Next
Close 13
Call IO.O
Strng="User record deleted:"+Space$(5)
Carriage.Return=True
Call IO.O
For Temp3=1 To Lof(3)/Len(UserRecord)
Get 3,Temp3,UserRecord
Call New.Stats
Out3=UserRecord.CodeName
Call Decrypt(Out3)
Temp=False
If TempX Then
If UserRecord.Level=False Then
Temp=True
Endif
Endif
If TempZ Then
Out2=UserRecord.DateOn
Call Decrypt(Out2)
If Int(DateValue#(Out2))<Temp# Then
Temp=True
Endif
Endif
If Temp Then
If Left$(Out3,9)<>Deleted$ Then
For Temp5=1 To 5
Call Back.Space
Next
Strng=Str$(Temp3)
Strng=Strng+Space$(5-Len(Strng))
Carriage.Return=True
Call IO.O
Endif
Call Delete.User
Endif
Put 3,Temp3,UserRecord
Next
Strng=Nul
Call IO.O
Graphics.Off=False
Strng="User file packed."
Call IO.O
10151
Exit Sub
10152
Resume 10151
End Sub
Sub Delete.User
On Local Error Goto 10162
Strng=Deleted$
Call Valid(Strng,30)
Call Encrypt(Strng,True)
UserRecord.CodeName=Strng
Strng=Deleted$
Call Valid(Strng,20)
Call Encrypt(Strng,False)
UserRecord.PassWord=Strng
Strng=Deleted$
Call Valid(Strng,20)
Call Encrypt(Strng,True)
UserRecord.ClassName=Strng
UserRecord.Level=False
UserRecord.Flags=False
UserRecord.ClassType=False
UserRecord.ToMin=False
UserRecord.ToHour=False
UserRecord.FromMin=False
UserRecord.FromHour=False
UserRecord.MaxCalls=False
For Temp6=1 To 15
UserRecord.Inv(Temp6)=False
UserRecord.Charges(Temp6)=False
Next
For Temp6=1 To 5
UserRecord.Object(Temp6)=False
UserRecord.ObjCharges(Temp6)=False
Next
10161
Exit Sub
10162
Resume 10161
End Sub
Sub Search.Users
On Local Error Goto 10172
Do
Temp1$=Nul
Temp2$=Nul
Temp3$=Nul
Temp1=False
Temp3=False
Temp4=False
Temp6=False
Temp7=False
Temp8=False
Temp9=False
Temp10=False
Temp11=False
Temp12=False
Temp13#=False
Temp14#=False
Temp15#=False
Temp16#=False
Temp17=False
Temp18=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]username substring"
If Temp1$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp1$+")"
Endif
Call IO.O
Strng="[B]password substring"
If Temp2$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp2$+")"
Endif
Call IO.O
Strng="[C]classname substring"
If Temp3$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Temp3$+")"
Endif
Call IO.O
Strng="[D]level"
If Temp1 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp1),2)+")"
Endif
Call IO.O
Strng="[E]class"
If Temp3 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Rtrim$(Class.Name(Temp3))+")"
Endif
Call IO.O
Strng="[F]weapon proficiency"
If Temp4 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Rtrim$(Weapon.Type.Name(Temp4))+")"
Endif
Call IO.O
Strng="[G]strength"
If Temp6 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp6),2)+")"
Endif
Call IO.O
Strng="[H]intelligence"
If Temp7 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp7),2)+")"
Endif
Call IO.O
Strng="[I]wisdom"
If Temp8 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp8),2)+")"
Endif
Call IO.O
Strng="[J]dexterity"
If Temp9 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp9),2)+")"
Endif
Call IO.O
Strng="[K]constitution"
If Temp10 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp10),2)+")"
Endif
Call IO.O
Strng="[L]piety"
If Temp11 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp11),2)+")"
Endif
Call IO.O
Strng="[M]charisma"
If Temp12 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp12),2)+")"
Endif
Call IO.O
Strng="[N]experience"
If Temp13# Then
If Temp14# Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp13#),2)+"-"+_
Mid$(Str$(Temp14#),2)+")"
Endif
Endif
Call IO.O
Strng="[O]gold"
If Temp15# Then
If Temp16# Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp15#),2)+"-"+_
Mid$(Str$(Temp16#),2)+")"
Endif
Endif
Call IO.O
Strng="[P]room number"
If Temp17 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp17),2)+")"
Endif
Call IO.O
Strng="[R]special character"
If Temp18 Then
Strng=Strng+Space$(30-Len(Strng))
Select Case Temp18
Case 1
Strng=Strng+"(town mayor)"
Case 2
Strng=Strng+"(governor)"
Case 3
Strng=Strng+"(guild master)"
Case 4
Strng=Strng+"(sysop)"
End Select
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="User search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Username substring?"
Call IO.I
Out2=Ucase$(Out2)
Temp1$=Out2
Case "B"
Strng="Password substring?"
Call IO.I
Out2=Ucase$(Out2)
Temp2$=Out2
Case "C"
Strng="Classname substring?"
Call IO.I
Out2=Ucase$(Out2)
Temp3$=Out2
Case "D"
Strng="Level?"
Call IO.I
Temp1=Int(Val(Out2))
Case "E"
If TempC=False Then
Graphics.Off=True
For Temp5=1 To 10
Strng="["+Mid$(Str$(Temp5),2)+"]"+Rtrim$(Class.Name(Temp5))
Call IO.O
Next
Graphics.Off=False
Endif
Strng="Class(1-10)?"
Call IO.I
Temp3=Int(Val(Out2))
If Temp3<1 Or Temp3>10 Then
Temp3=False
Endif
Case "F"
If TempC=False Then
Graphics.Off=True
For Temp5=1 To 4
Strng="["+Mid$(Str$(Temp5),2)+"]"+_
Rtrim$(Weapon.Type.Name(Temp5))
Call IO.O
Next
Graphics.Off=False
Endif
Strng="Weapon proficiency(1-4)?"
Call IO.I
Temp4=Int(Val(Out2))
If Temp4<1 Or Temp4>4 Then
Temp4=False
Endif
Case "G"
Strng="Strength?"
Call IO.I
Temp6=Int(Val(Out2))
Case "H"
Strng="Intelligence?"
Call IO.I
Temp7=Int(Val(Out2))
Case "I"
Strng="Wisdom?"
Call IO.I
Temp8=Int(Val(Out2))
Case "J"
Strng="Dexterity?"
Call IO.I
Temp9=Int(Val(Out2))
Case "K"
Strng="Constitution?"
Call IO.I
Temp10=Int(Val(Out2))
Case "L"
Strng="Piety?"
Call IO.I
Temp11=Int(Val(Out2))
Case "M"
Strng="Charisma?"
Call IO.I
Temp12=Int(Val(Out2))
Case "N"
Strng="Enter range:"
Call IO.O
No.Input.Out="1"
Strng="From?"
Call IO.I
Temp13#=Val(Out2)
No.Input.Out="10"
Strng="To?"
Call IO.I
Temp14#=Val(Out2)
Case "O"
Strng="Enter range:"
Call IO.O
No.Input.Out="1"
Strng="From?"
Call IO.I
Temp15#=Val(Out2)
No.Input.Out="10"
Strng="To?"
Call IO.I
Temp16#=Val(Out2)
Case "P"
Strng="Room number?"
Call IO.I
Temp17=Int(Val(Out2))
Case "R"
If TempC=False Then
Graphics.Off=True
Strng="[1]town mayor"
Call IO.O
Strng="[2]governor"
Call IO.O
Strng="[3]guild master"
Call IO.O
Strng="[4]sysop"
Call IO.O
Graphics.Off=False
Endif
Strng="Special character(1-4)?"
Call IO.I
Temp18=Int(Val(Out2))
If Temp18<1 Or Temp18>4 Then
Temp18=False
Endif
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(3)/Len(UserRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp2>Temp5 Then
Temp2=Temp5
Endif
For Temp5=Temp To Temp2
Get 3,Temp5,UserRecord
TempX=False
If Temp1$<>Nul Then
Call Decrypt(UserRecord.Codename)
If Instr(Out3,Temp1$) Then
TempX=True
Endif
Endif
If Temp2$<>Nul Then
Call Decrypt(UserRecord.Password)
If Instr(Out3,Temp2$) Then
TempX=True
Endif
Endif
If Temp3$<>Nul Then
Call Decrypt(UserRecord.Classname)
If Instr(Out3,Temp3$) Then
TempX=True
Endif
Endif
If Temp1 Then
If UserRecord.Level=Temp1 Then
TempX=True
Endif
Endif
If Temp3 Then
If UserRecord.ClassType=Temp3 Then
TempX=True
Endif
Endif
If Temp4 Then
If UserRecord.Proficiency=Temp4 Then
TempX=True
Endif
Endif
If Temp6 Then
If UserRecord.Stats(1)=Temp6 Then
TempX=True
Endif
Endif
If Temp7 Then
If UserRecord.Stats(2)=Temp7 Then
TempX=True
Endif
Endif
If Temp8 Then
If UserRecord.Stats(3)=Temp8 Then
TempX=True
Endif
Endif
If Temp9 Then
If UserRecord.Stats(4)=Temp9 Then
TempX=True
Endif
Endif
If Temp10 Then
If UserRecord.Stats(5)=Temp10 Then
TempX=True
Endif
Endif
If Temp11 Then
If UserRecord.Stats(6)=Temp11 Then
TempX=True
Endif
Endif
If Temp12 Then
If UserRecord.Stats(7)=12 Then
TempX=True
Endif
Endif
If Temp13 And Temp14 Then
If UserRecord.Experience>=Temp13 And_
UserRecord.Experience<=Temp14 Then
TempX=True
Endif
Endif
If Temp15 And Temp16 Then
If UserRecord.Gold>=Temp15 And_
UserRecord.Gold<=Temp16 Then
TempX=True
Endif
Endif
If Temp17 Then
If UserRecord.Room=Temp17 Then
TempX=True
Endif
Endif
If Temp18 Then
Select Case Temp18
Case 1
If UserRecord.Flags And Special.Char1 Then
TempX=True
Endif
Case 2
If UserRecord.Flags And Special.Char2 Then
TempX=True
Endif
Case 3
If UserRecord.Flags And Special.Char3 Then
TempX=True
Endif
Case 4
If UserRecord.Flags And Special.Char4 Then
TempX=True
Endif
End Select
Endif
If TempX Then
Call Decrypt(UserRecord.Codename)
If Left$(Out3,9)<>Deleted$ Then
Call Display.User(False)
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10171
Exit Sub
10172
Resume 10171
End Sub
Sub Edit.Inventory
On Local Error Goto 10182
Temp9=True
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd"
Call IO.O
Strng="[D]elete"
Call IO.O
If Temp9 Then
Strng="[E]dit Objects"
Else
Strng="[E]dit Treasure"
Endif
Call IO.O
Strng="[L]ist"
Call IO.O
Graphics.Off=False
Endif
Strng="Inventory edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
If Temp9 Then
Call Find.Treasure
If Temp5 Then
For Temp2=1 To 15
If UserRecord.Inv(Temp2)=False Then
UserRecord.Inv(Temp2)=Temp5
UserRecord.Charges(Temp2)=TreasureRecord.Charges
Temp5=True
Exit For
Endif
Next
Endif
Strng="Treasure not added to inventory."
If Temp5=True Then
Strng="Treasure added to inventory."
Endif
Call IO.O
Else
Call Find.Object
If Temp Then
For Temp2=1 To 5
If UserRecord.Object(Temp2)=False Then
UserRecord.Object(Temp2)=Temp
UserRecord.ObjCharges(Temp2)=False
Temp=True
Exit For
Endif
Next
Endif
Strng="Object not added to inventory."
If Temp=True Then
Strng="Object added to inventory."
Endif
Call IO.O
Endif
Case "D"
If Temp9 Then
Strng="Number to delete?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp>False And Temp<=15 Then
If UserRecord.Inv(Temp)>False Then
For Temp5=Temp To 14
UserRecord.Inv(Temp5)=UserRecord.Inv(Temp5+1)
UserRecord.Charges(Temp5)=UserRecord.Charges(Temp5+1)
Next
Temp=True
UserRecord.Inv(15)=False
UserRecord.Charges(15)=False
Endif
Endif
Strng="Treasure not deleted from inventory."
If Temp=True Then
Strng="Treasure deleted from inventory"
Endif
Call IO.O
Else
Strng="Number to delete?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp>False And Temp<=5 Then
If UserRecord.Object(Temp)>False Then
For Temp5=Temp To 4
UserRecord.Object(Temp5)=UserRecord.Object(Temp5+1)
UserRecord.ObjCharges(Temp5)=UserRecord.ObjCharges(Temp5+1)
Next
Temp=True
UserRecord.Object(5)=False
UserRecord.ObjCharges(5)=False
Endif
Endif
Strng="Object not deleted from inventory."
If Temp=True Then
Strng="Object deleted from inventory"
Endif
Call IO.O
Endif
Case "L"
If Temp9 Then
Graphics.Off=True
For Temp5=1 To 15
Temp=UserRecord.Inv(Temp5)
If Temp<False Then
Temp=Abs(Temp)
UserRecord.Inv(Temp5)=Temp
Endif
If Temp>False And Temp<=Lof(8)/Len(TreasureRecord) Then
Get 8,Temp,TreasureRecord
Out3=TreasureRecord.TreasureName
Out3=Lcase$(Out3)
Strng=Mid$(Str$(Temp5),2)+"."+Out3
Call IO.O
Endif
Next
Else
Graphics.Off=True
For Temp5=1 To 5
Temp=UserRecord.Object(Temp5)
If Temp<False Then
UserRecord.Object(Temp5)=False
UserRecord.ObjCharges(Temp5)=False
Else
If Temp>False And Temp<=Lof(6)/Len(ObjectRecord) Then
Get 6,Temp,ObjectRecord
Out3=ObjectRecord.ObjectName
Out3=Lcase$(Out3)
Strng=Mid$(Str$(Temp5),2)+"."+Out3
Call IO.O
Endif
Endif
Next
Endif
Case "E"
Temp9=Not Temp9
If Temp9 Then
Strng="Now editing treasure."
Else
Strng="Now editing objects."
Endif
Call IO.O
Case "Q"
Exit Do
End Select
Loop
10181
Exit Sub
10182
Resume 10181
End Sub
Sub Edit.Room
On Local Error Goto 10192
If Lof(5)=False Then
Call Add.Room
Endif
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd room"
Call IO.O
Strng="[D]escription edit"
Call IO.O
Strng="[M]onster class"
Call IO.O
Strng="[O]bject edit"
Call IO.O
Strng="[R]oom link"
Call IO.O
Strng="[T]reasure edit"
Call IO.O
Graphics.Off=False
Endif
Strng="Room edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Add.Room
Case "D"
Call Edit.Description
Case "M"
Call Edit.Room.MonsterClass
Case "R"
Call Edit.Room.Links
Case "O"
Call Edit.Room.Object
Case "T"
Call Edit.Room.Treasure
Case "Q"
Exit Do
End Select
Loop
10191
Exit Sub
10192
Resume 10191
End Sub
Sub Add.Room
On Local Error Goto 10202
Temp4=Lof(5)/Len(RoomRecord)+1
RoomRecord.ShortDesc=Nul
RoomRecord.Restrictions=False
RoomRecord.MonsterClass=False
RoomRecord.SpellTrigger=False
RoomRecord.MonsterTrigger=False
RoomRecord.HealthRate=False
RoomRecord.EncounterRate=False
RoomRecord.HitPoints=False
RoomRecord.Inventory=False
RoomRecord.MonsterTalk=False
RoomRecord.Fumble=False
RoomRecord.Level=False
RoomRecord.Teleport=False
RoomRecord.RustRate=False
RoomRecord.StealRate=False
For Temp6=1 To 4
RoomRecord.LongDesc(Temp6)=Nul
Next
For Temp6=1 To 11
RoomRecord.Direct(Temp6)=False
Next
For Temp6=1 To 10
RoomRecord.Object(Temp6)=False
RoomRecord.ObjCharges(Temp6)=False
RoomRecord.Treasure(Temp6)=False
RoomRecord.TreCharges(Temp6)=False
RoomRecord.Flags(Temp6)=False
Next
Put 5,Temp4,RoomRecord
Call Edit.Description
Call Edit.Room.MonsterClass
10201
Exit Sub
10202
Resume 10201
End Sub
Sub Edit.Description
On Local Error Goto 10212
Do
Graphics.Off=True
If TempC=False Then
Strng="[E]dit description"
Call IO.O
Strng="[L]ist description"
Call IO.O
Strng="[S]earch description"
Call IO.O
Graphics.Off=False
Endif
Strng="Room description edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "E"
Call Modify.Description
Case "L"
Call List.Room
Case "S"
Call Search.Description
Case "Q"
Exit Do
End Select
Loop
10211
Exit Sub
10212
Resume 10211
End Sub
Sub Modify.Description
On Local Error Goto 10222
Temp3=Lof(5)/Len(RoomRecord)
Strng="Room number(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<1 Or Temp2>Temp3 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Graphics.Off=True
Get 5,Temp2,RoomRecord
Strng="Short description:"
Call IO.O
Strng=Rtrim$(RoomRecord.ShortDesc)
Call IO.O
Strng="Enter new short description:"
Call IO.O
Strng="Press "+Enter$+" to leave unchanged."
Call IO.O
Strng="?"
Call IO.I
If No.Input=False Then
RoomRecord.ShortDesc=Out2
Endif
Put 5,Temp2,RoomRecord
Strng="Edit long description(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If Yes Then
Strng="Enter four lines for new description:"
Call IO.O
Strng="Press "+Enter$+" when done."
Call IO.O
For Temp3=1 To 4
RoomRecord.LongDesc(Temp3)=Nul
Next
Word.Wrap=True
For Temp3=1 To 4
Strng="?"
If Temp3=4 Then
Word.Wrap=False
Endif
Call IO.I
If No.Input Then
Exit For
Endif
RoomRecord.LongDesc(Temp3)=Out2
Next
Word.Wrap=False
Put 5,Temp2,RoomRecord
Endif
10221
Exit Sub
10222
Resume 10221
End Sub
Sub List.Room
On Local Error Goto 10232
Strng="Enter range:"
Call IO.O
Temp3=Lof(5)/Len(RoomRecord)
Temp$=Mid$(Str$(Temp3),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Sub
Endif
If Temp2>Temp3 Then
Temp2=Temp3
Endif
For Temp5=Temp To Temp2
Get 5,Temp5,RoomRecord
Call Display.Room
Call More.Prompt
If No Then
Exit For
Endif
Next
10231
Exit Sub
10232
Resume 10231
End Sub
Sub Display.Room
On Local Error Goto 10242
If TempC Then
Exit Sub
Endif
Graphics.Off=True
Strng="Room number"+Str$(Temp5)+":"
Call IO.O
Strng="Short description:"
Call IO.O
Strng=Rtrim$(RoomRecord.ShortDesc)
Call IO.O
Strng="Long description:"
Call IO.O
For Temp3=1 To 4
Strng=RoomRecord.LongDesc(Temp3)
Strng=Rtrim$(Strng)
If Len(Strng) Then
Call IO.O
Endif
Next
10241
Exit Sub
10242
Resume 10241
End Sub
Sub Edit.Room.MonsterClass
On Local Error Goto 10252
Temp3=Lof(5)/Len(RoomRecord)
Strng="Room number(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp3 Then
Strng="Out of range"
Call IO.O
Exit Sub
Endif
Temp3=Lof(10)/Len(MonclassRecord)
Strng="Monster class(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<1 Or Temp2>Temp3 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Get 5,Temp,RoomRecord
RoomRecord.MonsterClass=Temp2
Put 5,Temp,RoomRecord
Strng="Monster class in room number"+Str$(Temp)+" changed."
Call IO.O
10251
Exit Sub
10252
Resume 10251
End Sub
Sub Edit.Room.Links
On Local Error Goto 10262
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd link"
Call IO.O
Strng="[R]emove link"
Call IO.O
Strng="[L]ist links"
Call IO.O
Strng="[S]earch links"
Call IO.O
Graphics.Off=False
Endif
Strng="Room link edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Change.Link(True)
Case "R"
Call Change.Link(False)
Case "L"
Call List.Links
Case "S"
Call Search.Links
Case "Q"
Exit Do
End Select
Loop
10261
Exit Sub
10262
Resume 10261
End Sub
Sub Change.Link(TempX)
On Local Error Goto 10272
Strng="Room number to link?"
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<1 Or Temp2>Lof(5)/Len(RoomRecord) Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="Direction:"
Call IO.O
Strng="N, E, S, W, O, U, D, NE, SE, SW, NW."
Call IO.O
Strng="Which direction?"
Call IO.I
Select Case Ucase$(Out2)
Case "N"
Temp7=1
Case "E"
Temp7=2
Case "S"
Temp7=3
Case "W"
Temp7=4
Case "O"
Temp7=5
Case "U"
Temp7=6
Case "D"
Temp7=7
Case "NE"
Temp7=8
Case "SE"
Temp7=9
Case "SW"
Temp7=10
Case "NW"
Temp7=11
Case Else
Temp7=False
End Select
If Temp7=False Then
Strng=Range$
Call IO.O
Exit Sub
Endif
If TempX=False Then
Get 5,Temp2,RoomRecord
RoomRecord.Direct(Temp7)=False
Put 5,Temp2,RoomRecord
Strng="Link removed."
Call IO.O
Exit Sub
Endif
Strng="Link to which room number?"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Lof(5)/Len(RoomRecord) Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Get 5,Temp2,RoomRecord
RoomRecord.Direct(Temp7)=Temp
Put 5,Temp2,RoomRecord
Strng="Room"+Str$(Temp2)+" linked to"+Str$(Temp)+"."
Call IO.O
If Temp7=5 Then
Exit Sub
Endif
Strng="Link back to room"+Str$(Temp2)+"(y/n)?"
No.Input.Out="N"
Call IO.I
If Yes=False Then
Exit Sub
Endif
Select Case Temp7
Case 1
Temp8=3
Case 2
Temp8=4
Case 3
Temp8=1
Case 4
Temp8=2
Case 6
Temp8=7
Case 7
Temp8=6
Case 8
Temp8=10
Case 9
Temp8=11
Case 10
Temp8=8
Case 11
Temp8=9
End Select
Get 5,Temp,RoomRecord
RoomRecord.Direct(Temp8)=Temp2
Put 5,Temp,RoomRecord
Strng="Room"+Str$(Temp)+" linked back to"+Str$(Temp2)+"."
Call IO.O
10271
Exit Sub
10272
Resume 10271
End Sub
Sub List.Links
On Local Error Goto 10282
Strng="Range of room numbers."
Call IO.O
Temp3=Lof(5)/Len(RoomRecord)
Temp$=Mid$(Str$(Temp3),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp3 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Then
Strng=Range$
Call IO.O
Exit Sub
Endif
If Temp2>Temp3 Then
Temp2=Temp3
Endif
Temp6=False
For Temp5=Temp To Temp2
Get 5,Temp5,RoomRecord
Graphics.Off=True
Strng="Room number"+Str$(Temp5)+":"
Call IO.O
For Temp3=1 To 7
Out2=Mid$("NESWOUD",Temp3,1)+_
Str$(RoomRecord.Direct(Temp3))
Strng=Strng+Out2+Space$(10-Len(Out2))
Next
Call IO.O
For Temp3=8 To 11
Out2=Mid$("NESESWNW",(Temp3-8)*2+1,2)+_
Str$(RoomRecord.Direct(Temp3))
Strng=Strng+Out2+Space$(10-Len(Out2))
Next
Call IO.O
Temp6=Temp6+3
If Temp6>=22 Then
Temp6=False
Call More.Prompt
If No Then
Exit For
Endif
Endif
Next
If Temp6 Then
Call More.Prompt
Endif
10281
Exit Sub
10282
Resume 10281
End Sub
Sub Search.Links
On Local Error Goto 10292
Do
Temp1=False
Temp2=False
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]room link"
If Temp1 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp1),2)+")"
Endif
Call IO.O
Strng="[B]room link and back"
If Temp2 Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+Mid$(Str$(Temp2),2)+")"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Room link search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Temp3=Lof(5)/Len(RoomRecord)
Temp$=Mid$(Str$(Temp3),2)
Select Case Ucase$(Out2)
Case "A"
Strng="Room link number(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp1=Int(Val(Out2))
If Temp1<1 Or Temp1>Temp3 Then
Strng=Range$
Call IO.O
Temp1=False
Endif
Case "B"
Strng="Room link number(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<1 Or Temp2>Temp3 Then
Strng=Range$
Call IO.O
Temp2=False
Endif
Case "S"
Strng="Enter range:"
Call IO.O
Temp5=Lof(5)/Len(RoomRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Do
Endif
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp3=Int(Val(Out2))
If Temp3<Temp Then
Strng=Range$
Call IO.O
Exit Do
Endif
If Temp4>Temp5 Then
Temp4=Temp5
Endif
For Temp5=Temp To Temp3
Get 5,Temp5,RoomRecord
For Temp4=1 To 11
TempX=False
If Temp1 Then
If RoomRecord.Direct(Temp4)=Temp1 Then
TempX=True
Endif
Endif
If Temp2 Then
If RoomRecord.Direct(Temp4)=Temp2 Then
If Temp4=1 Then
Temp8=3
Endif
If Temp4=2 Then
Temp8=4
Endif
If Temp4=3 Then
Temp8=1
Endif
If Temp4=4 Then
Temp8=2
Endif
If Temp4=6 Then
Temp8=7
Endif
If Temp4=7 Then
Temp8=6
Endif
If Temp4=8 Then
Temp8=10
Endif
If Temp4=9 Then
Temp8=11
Endif
If Temp4=10 Then
Temp8=8
Endif
If Temp4=11 Then
Temp8=9
Endif
Get 5,Temp2,RoomRecord
If RoomRecord.Direct(Temp8)=Temp5 Then
TempX=True
Endif
Get 5,Temp5,RoomRecord
Endif
Endif
If TempX Then
Graphics.Off=True
Strng="Room number"+Str$(Temp5)+":"
Call IO.O
If Temp4>False And Temp4<8 Then
Strng=Mid$("NESWOUD",Temp4,1)
Endif
If Temp4>7 And Temp4<12 Then
Strng=Mid$("NESESWNW",(Temp4-1)*2+1,2)
Endif
Strng=Strng+Str$(RoomRecord.Direct(Temp4))
Call IO.O
If Temp2 Then
Get 5,Temp2,RoomRecord
Strng="Room number"+Str$(Temp2)+":"
Call IO.O
If Temp8>False And Temp8<8 Then
Strng=Mid$("NESWOUD",Temp4,1)
Endif
If Temp8>7 And Temp8<12 Then
Strng=Mid$("NESESWNW",(Temp8-1)*2+1,2)
Endif
Strng=Strng+Str$(RoomRecord.Direct(Temp8))
Call IO.O
Get 5,Temp5,RoomRecord
Endif
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10291
Exit Sub
10292
Resume 10291
End Sub
Sub Edit.Room.Object
On Local Error Goto 10302
Temp5=Lof(5)/Len(RoomRecord)
Strng="Room number(1-"+Mid$(Str$(Temp5),2)+")?"
No.Input.Out="1"
Call IO.I
Temp3=Int(Val(Out2))
If Temp3<1 Or Temp3>Temp5 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd"
Call IO.O
Strng="[D]elete"
Call IO.O
Strng="[L]ist"
Call IO.O
Graphics.Off=False
Endif
Strng="Room object edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Find.Object
If Temp Then
For Temp2=1 To 10
If RoomRecord.Object(Temp2)=False Then
RoomRecord.Object(Temp2)=Temp
RoomRecord.ObjCharges(Temp2)=False
RoomRecord.Flags(Temp2)=False
Put 5,Temp3,RoomRecord
Temp=True
Exit For
Endif
Next
Endif
Strng="Object not added to room."
If Temp=True Then
Strng="Object added to room."
Endif
Call IO.O
Case "D"
Strng="Object number to delete?"
No.Input.Out="1"
Call IO.I
Temp=False
Temp5=Int(Val(Out2))
If Temp5>False And Temp5<=10 Then
If RoomRecord.Object(Temp5) Then
RoomRecord.Object(Temp5)=False
RoomRecord.ObjCharges(Temp5)=False
RoomRecord.Flags(Temp5)=False
Temp=True
Put 5,Temp3,RoomRecord
Endif
Endif
Strng="Object not deleted from room."
If Temp=True Then
Strng="Object deleted from room."
Endif
Call IO.O
Case "L"
Get 5,Temp3,RoomRecord
Graphics.Off=True
For Temp5=1 To 10
Temp2=RoomRecord.Object(Temp5)
If Temp2>False And Temp2<=Lof(6)/Len(ObjectRecord) Then
Get 6,Temp2,ObjectRecord
Strng=Mid$(Str$(Temp5),2)+"."+Rtrim$(ObjectRecord.ObjectName)
Call IO.O
Endif
Next
Case "Q"
Exit Do
End Select
Loop
10301
Exit Sub
10302
Resume 10301
End Sub
Sub Edit.Room.Treasure
On Local Error Goto 10312
Temp5=Lof(5)/Len(RoomRecord)
Strng="Room number(1-"+Mid$(Str$(Temp5),2)+")?"
No.Input.Out="1"
Call IO.I
Temp3=Int(Val(Out2))
If Temp3<1 Or Temp3>Temp5 Then
Strng="Out of Range"
Call IO.O
Exit Sub
Endif
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd"
Call IO.O
Strng="[D]elete"
Call IO.O
Strng="[L]ist
Call IO.O
Graphics.Off=False
Endif
Strng="Room treasure edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Find.Treasure
If Temp5 Then
For Temp2=1 To 10
If RoomRecord.Treasure(Temp2)=False Then
RoomRecord.Treasure(Temp2)=Temp5
RoomRecord.TreCharges(Temp2)=TreasureRecord.Charges
RoomRecord.Flags(Temp2)=False
Temp5=True
Put 5,Temp3,RoomRecord
Exit For
Endif
Next
Endif
Strng="Treasure not added to room."
If Temp5=True Then
Strng="Treasure added to room."
Endif
Call IO.O
Case "D"
Strng="Treasure number to delete?"
No.Input.Out="1"
Call IO.I
Temp=False
Temp5=Int(Val(Out2))
If Temp5>False And Temp5<=10 Then
If RoomRecord.Treasure(Temp5) Then
RoomRecord.Treasure(Temp5)=False
RoomRecord.TreCharges(Temp5)=False
RoomRecord.Flags(Temp5)=False
Temp=True
Put 5,Temp3,RoomRecord
Endif
Endif
Strng="Treasure not deleted from room."
If Temp=True Then
Strng="Treasure deleted from room."
Endif
Call IO.O
Case "L"
Get 5,Temp3,RoomRecord
Graphics.Off=True
For Temp5=1 To 10
Temp2=RoomRecord.Treasure(Temp5)
If Temp2>False And Temp2<=Lof(8)/Len(TreasureRecord) Then
Get 8,Temp2,TreasureRecord
Strng=Mid$(Str$(Temp5),2)+"."+Rtrim$(TreasureRecord.TreasureName)
Call IO.O
Endif
Next
Case "Q"
Exit Do
End Select
Loop
10311
Exit Sub
10312
Resume 10311
End Sub
Sub Display.BaseTypes
On Local Error Goto 10322
If TempC Then
Exit Sub
Endif
Graphics.Off=True
Strng="[1]public"
Call IO.O
Strng="[2]private"
Call IO.O
Strng="[3]DMs only"
Call IO.O
Strng="[4]Sysops only"
Call IO.O
Strng="[5]Town Mayors only"
Call IO.O
Strng="[6]Governors only"
Call IO.O
Strng="[7]Guild Masters only"
Call IO.O
Strng="[8]Clear base types"
Call IO.O
Graphics.Off=False
10321
Exit Sub
10322
Resume 10321
End Sub
Sub Edit.Mail
On Local Error Goto 10332
Redim Temp.ArrayS(1 To 19) As String
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]dd message base"
Call IO.O
Strng="[C]hange message base"
Call IO.O
Strng="[D]elete message base"
Call IO.O
Strng="[E]dit messages"
Call IO.O
Strng="[L]ist message bases"
Call IO.O
Strng="[S]earch message bases"
Call IO.O
Graphics.Off=False
Endif
Strng="Message base edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Add.Base
Case "C"
Call Change.Base
Case "D"
Call Delete.Base
Case "E"
Call Edit.Messages
Case "L"
Call List.Bases
Case "S"
Call Search.Bases
Case "Q"
Exit Do
End Select
Loop
10331
Exit Sub
10332
Resume 10331
End Sub
Sub Add.Base
On Local Error Goto 10342
Do
Graphics.Off=True
Strng="Message base topic name?"
No.Input.Out=None$
Call IO.I
Out3=Ucase$(Out2)
Strng="Message base filename(8 letters DOS)?"
No.Input.Out=None$
Call IO.I
Out4=Ucase$(Out2)
Temp2=False
Do
Call Display.BaseTypes
Strng="Message base type option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
If Ucase$(Out2)="Q" Then
Exit Do
Endif
Select Case Val(Out2)
Case 1
Temp2=Temp2 Or Public.Base
Case 2
Temp2=Temp2 Or Private.Base
Case 3
Temp2=Temp2 Or DM.Base
Case 4
Temp2=Temp2 Or Sysop.Base
Case 5
Temp2=Temp2 Or TownMayor.Base
Case 6
Temp2=Temp2 Or Governor.Base
Case 7
Temp2=Temp2 Or GuildMaster.Base
Case 8
Temp2=False
End Select
Loop
Graphics.Off=False
Strng="Add to message base file(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If Yes Then
For Temp=1 To Lof(12)/Len(MessageBaseRecord)
Get 12,Temp,MessageBaseRecord
If Left$(MessageBaseRecord.BaseMessName,9)=Deleted$ Then
Exit For
Endif
Next
MessageBaseRecord.BaseMessName=Out3
MessageBaseRecord.BaseFileName=Out4
MessageBaseRecord.BaseType=Temp2
MessageBaseRecord.EmptyBuffer=False
Put 12,Temp,MessageBaseRecord
Endif
Strng="Add another message base(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If No Then
Exit Do
Endif
Loop
10341
Exit Sub
10342
Resume 10341
End Sub
Sub Change.Base
On Local Error Goto 10352
Temp3=Lof(12)/Len(MessageBaseRecord)
Strng="Message base number(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Temp5=Int(Val(Out2))
If Temp5<1 Or Temp5>Temp3 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Get 12,Temp5,MessageBaseRecord
Do
Graphics.Off=True
If TempC=False Then
Strng="[C]lasstype"
Call IO.O
Strng="[F]ilename"
Call IO.O
Strng="[T]opic"
Call IO.O
Graphics.Off=False
Endif
Strng="Message base change option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "C"
Temp2=MessageBaseRecord.BaseType
Do
Call Display.BaseTypes
Strng="Message base type option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
If Ucase$(Out2)="Q" Then
Exit Do
Endif
Select Case Val(Out2)
Case 1
Temp2=Temp2 Or Public.Base
Case 2
Temp2=Temp2 Or Private.Base
Case 3
Temp2=Temp2 Or DM.Base
Case 4
Temp2=Temp2 Or Sysop.Base
Case 5
Temp2=Temp2 Or TownMayor.Base
Case 6
Temp2=Temp2 Or Governor.Base
Case 7
Temp2=Temp2 Or GuildMaster.Base
Case 8
Temp2=False
End Select
Loop
MessageBaseRecord.BaseType=Temp2
Case "F"
Strng="Message base filename(8 letters DOS)?"
No.Input.Out=None$
Call IO.I
MessageBaseRecord.BaseFileName=Ucase$(Out2)
Case "T"
Strng="Message base topic name?"
No.Input.Out=None$
Call IO.I
MessageBaseRecord.BaseMessName=Ucase$(Out2)
Case "Q"
Exit Do
End Select
Loop
Put 12,Temp5,MessageBaseRecord
Strng="Message base number"+Str$(Temp5)+" changed."
Call IO.O
10351
Exit Sub
10352
Resume 10351
End Sub
Sub Delete.Base
On Local Error Goto 10362
Temp3=Lof(12)/Len(MessageBaseRecord)
Strng="Delete base number(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Temp5=Val(Out2)
If Temp5<1 Or Temp5>Temp3 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Get 12,Temp5,MessageBaseRecord
MessageBaseRecord.BaseMessName=Deleted$
MessageBaseRecord.BaseFileName=None$
MessageBaseRecord.BaseType=False
MessageBaseRecord.EmptyBuffer=False
Put 12,Temp5,MessageBaseRecord
Strng="Message base number"+Str$(Temp5)+" deleted."
Call IO.O
10361
Exit Sub
10362
Resume 10361
End Sub
Sub Edit.Messages
On Local Error Goto 10372
Temp3=Lof(12)/Len(MessageBaseRecord)
Strng="Enter(P for public, R for private) or,"
Call IO.O
Strng="Edit base number(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Select Case Ucase$(Out2)
Case "P"
TempA$="public"
TempX$=Config3(58)
Case "R"
TempA$="private"
TempX$=Config3(60)
Case Else
Select Case Val(Out2)
Case 1 To Temp3
Get 12,Val(Out2),MessageBaseRecord
If Left$(MessageBaseRecord.BaseMessName,9)=Deleted$ Then
Strng="Deleted message base."
Call IO.O
Exit Sub
Endif
TempA$=Rtrim$(MessageBaseRecord.BaseMessName)
TempX$=Rtrim$(MessageBaseRecord.BaseFileName)
Case Else
Strng=Range$
Call IO.O
Exit Sub
End Select
End Select
Var$="Editing "+Lcase$(TempA$)+" message base."
Call Open.Mail
Do
Strng=Var$
Call IO.O
Graphics.Off=True
If TempC=False Then
Strng="[A]dd message"
Call IO.O
Strng="[C]hange message"
Call IO.O
Strng="[D]elete message"
Call IO.O
Strng="[L]ist messages"
Call IO.O
Strng="[S]earch messages"
Call IO.O
Strng="[U]ndelete message"
Call IO.O
Graphics.Off=False
Endif
Strng="Message edit option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Call Add.Message
Case "C"
Call Change.Message
Case "D"
Call Delete.Message
Case "L"
Call List.Messages
Case "S"
Call Search.Messages
Case "U"
Call Undelete.Message
Case "Q"
Exit Do
End Select
Loop
10371
Exit Sub
10372
Resume 10371
End Sub
Sub Add.Message
On Local Error Goto 10382
For Temp2=1 To 19
Temp.ArrayS(Temp2)=Nul
Next
Graphics.Off=True
Strng="From(press "+Enter$+" for Sysop)?"
No.Input.Out="Sysop"
Call IO.I
Strng3=Out2
Strng="To(press "+Enter$+" for All)?"
No.Input.Out="All"
Call IO.I
Message.To=Ucase$(Out2)
Strng="Subject?"
Call IO.I
Subject=Lcase$(Out2)
Strng="Stat(press "+Enter$+" for Sysop)?"
No.Input.Out="Sysop"
Call IO.I
Message.Stat=Out2
Strng="Enter message. Maximum 19 lines."
Call IO.O
Message.Length=False
Do
Strng="Press "+Enter$+" on a blank line to edit."
Call IO.O
Do
Graphics.Off=True
If Message.Length=19 Then
Strng="Message buffer full."
Call IO.O
Exit Do
Endif
Word.Wrap=True
Strng="?"
Call IO.I
If No.Input Then
Exit Do
Endif
Message.Length=Message.Length+1
Temp.ArrayS(Message.Length)=Out2
Loop
Word.Wrap=False
Call More.Prompt
Call Edit.Message(VarX)
If VarX=-1 Then
Strng="Continue editing."
Call IO.O
Endif
If VarX=0 Then
Exit Do
Endif
If VarX=1 Then
Call Store.Message
Exit Do
Endif
Loop
10381
Exit Sub
10382
Resume 10381
End Sub
Sub Change.Message
On Local Error Goto 10392
Do
Graphics.Off=False
Temp5=Lof(1)/Len(TableRecord)
Strng="Message number to edit(1-"+Mid$(Str$(Temp5),2)+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Else
Get 1,Temp,TableRecord
Strng="Edit message header(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If Yes Then
Graphics.Off=True
Strng="From: "+TableRecord.MessageFrom
Call IO.O
Out2=TableRecord.MessageTo
Out2=Rtrim$(Out2)
If Out2=Nul Then
Out2="ALL"
Endif
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Strng="To: "+Out2
Call IO.O
Strng="Subj: "+TableRecord.MessageSubject
Call IO.O
Graphics.Off=False
Strng="Enter new message header:"
Call IO.O
Graphics.Off=True
Strng="From(press "+Enter$+" for Sysop)?"
No.Input.Out="Sysop"
Call IO.I
Strng3=Out2
Strng="To(press "+Enter$+" for All)?"
No.Input.Out="All"
Call IO.I
Message.To=Ucase$(Out2)
Strng="Subject?"
Call IO.I
Subject=Lcase$(Out2)
TableRecord.MessageFrom=Strng3
TableRecord.MessageTo=Message.To
If Subject<>Nul Then
TableRecord.MessageSubject=Subject
Endif
Put 1,Temp,TableRecord
Endif
Graphics.Off=False
Strng="Edit message text(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If Yes Then
Allow.Break=True
Graphics.Off=True
For Temp2=TableRecord.MessageStart To_
TableRecord.MessageStart+TableRecord.MessageLength-1
Get 2,Temp2,MessageRecord
Strng=MessageRecord.Message
VarX=Instr(Strng,Chr$(1))
If VarX Then
Strng=Left$(Strng,VarX-1)
Endif
Strng=Rtrim$(Strng)
Call IO.O
If Break Then
Exit For
Endif
Next
Allow.Break=False
Do
Graphics.Off=False
Temp5=TableRecord.MessageLength
Strng="Line number to edit(1-"+Mid$(Str$(Temp5),2)+",q to quit)?"
No.Input.Out="Q"
Call IO.I
If Ucase$(Out2)="Q" Then
Exit Do
Endif
Temp2=Int(Val(Out2))
If Temp2<1 Or Temp2>Temp5 Then
Strng=Range$
Call IO.O
Else
Strng="New message text:"
Call IO.O
Graphics.Off=True
Strng="?"
Call IO.I
MessageRecord.Message=Left$(Out2,79)+Chr$(1)
Put 2,TableRecord.MessageStart+Temp2-1,MessageRecord
Endif
Loop
Endif
Endif
Graphics.Off=False
Strng="Edit another message(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If No Then
Exit Do
Endif
Loop
10391
Exit Sub
10392
Resume 10391
End Sub
Sub Delete.Message
On Local Error Goto 10402
Do
Temp3=Lof(1)/Len(TableRecord)
Strng="Message number to delete(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Graphics.Off=True
Temp=Val(Out2)
If Temp<1 Or Temp>Temp3 Then
Strng=Range$
Call IO.O
Else
Get 1,Temp,TableRecord
If TableRecord.MessageKilled="T" Then
Strng="Message"+Str$(Temp)+" is already deleted."
Call IO.O
Else
TableRecord.MessageKilled="T"
Put 1,Temp,TableRecord
Strng="Message"+Str$(Temp)+" deleted."
Call IO.O
Endif
Endif
Graphics.Off=False
Strng="Delete more messages(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If No Then
Exit Do
Endif
Loop
10401
Exit Sub
10402
Resume 10401
End Sub
Sub List.Messages
On Local Error Goto 10412
Temp5=Lof(1)/Len(TableRecord)
Temp$=Mid$(Str$(Temp5),2)
Strng="From(1-"+Temp$+")?"
No.Input.Out="1"
Call IO.I
Temp=Int(Val(Out2))
Strng="To("+Mid$(Str$(Temp),2)+"-"+Temp$+")?"
No.Input.Out=Temp$
Call IO.I
Temp1=Int(Val(Out2))
If Temp<1 Or Temp>Temp1 Or Temp>Temp5 Then
Strng=Range$
Call IO.O
Exit Sub
Endif
If Temp1>Temp5 Then
Temp1=Temp5
Endif
Graphics.Off=True
For Temp2=Temp To Temp1
Get 1,Temp2,TableRecord
If TableRecord.MessageKilled="T" Then
Strng="Message number"+Str$(Temp2)+" was deleted."
Call IO.O
Else
Graphics.Off=True
Strng="Msg#:"+Str$(Temp2)+" of"+Str$(Lof(1)/Len(TableRecord))
Call IO.O
Strng="From: "+TableRecord.MessageFrom
Call IO.O
Out2=TableRecord.MessageTo
Out2=Rtrim$(Out2)
If Out2=Nul Then
Out2="ALL"
Endif
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Strng="To: "+Out2
Call IO.O
Strng="Subj: "+TableRecord.MessageSubject
Call IO.O
Strng="Time: "+TableRecord.MessageTime
Call IO.O
Allow.Break=True
For Temp5=TableRecord.MessageStart To_
TableRecord.MessageStart+TableRecord.MessageLength-1
Get 2,Temp5,MessageRecord
Strng=MessageRecord.Message
VarX=Instr(Strng,Chr$(1))
If VarX Then
Strng=Left$(Strng,VarX-1)
Endif
Strng=Rtrim$(Strng)
Call IO.O
If Break Then
Exit For
Endif
Next
Endif
Allow.Break=False
Call More.Prompt
If No Then
Exit For
Endif
Next
10411
Exit Sub
10412
Resume 10411
End Sub
Sub Search.Messages
On Local Error Goto 10422
Do
TempA$=Nul
TempB$=Nul
TempC$=Nul
TempE$=Nul
TempF$=Nul
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]from user"
If TempA$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempA$+")"
Endif
Call IO.O
Strng="[B]subject header"
If TempB$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempB$+")"
Endif
Call IO.O
Strng="[C]date of message"
If TempC$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempC$+")"
Endif
Call IO.O
Strng="[D]to user"
If TempE$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempE$+")"
Endif
Call IO.O
Strng="[E]message text"
If TempF$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempF$+")"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Message search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Graphics.Off=False
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Username?"
Call IO.I
TempA$=Ucase$(Out2)
Case "B"
Strng="Subject substring?"
Call IO.I
TempB$=Ucase$(Out2)
Case "C"
Strng="Search date?"
Call IO.I
TempC$=Ucase$(Out2)
Case "D"
Strng="Username?"
Call IO.I
TempE$=Ucase$(Out2)
Case "E"
Strng="Message text substring?"
Call IO.I
TempF$=Ucase$(Out2)
Case "S"
Strng="Searching messages."
Call IO.O
For Temp=1 To Lof(1)/Len(TableRecord)
Get 1,Temp,TableRecord
Temp2=False
If TempA$<>Nul Then
If Instr(Ucase$(TableRecord.MessageFrom),TempA$) Then
Temp2=True
Endif
Endif
If TempB$<>Nul Then
If Instr(Ucase$(TableRecord.MessageSubject),TempB$) Then
Temp2=True
Endif
Endif
If TempC$<>Nul Then
If Int(DateValue#(TableRecord.MessageTime))=_
Int(DateValue#(TempC$)) Then
Temp2=True
Endif
Endif
If TempE$<>Nul Then
If Rtrim$(TableRecord.MessageTo)=Nul Then
If TempE$="ALL" Then
Temp2=True
Endif
Else
If Instr(Ucase$(TableRecord.MessageTo),TempE$) Then
Temp2=True
Endif
Endif
Endif
If TempF$<>Nul Then
For Temp4=TableRecord.MessageStart+1 To_
TableRecord.MessageStart+TableRecord.MessageLength-1
Get 2,Temp4,MessageRecord
If Instr(Ucase$(MessageRecord.Message),TempF$) Then
Temp2=True
Temp3=Temp4-TableRecord.MessageStart
Exit For
Endif
Next
Endif
If Temp2 Then
Graphics.Off=True
Strng="From: "+TableRecord.MessageFrom
Call IO.O
Out2=TableRecord.MessageTo
Out2=Rtrim$(Out2)
If Out2=Nul Then
Out2="ALL"
Endif
Out2=Lcase$(Out2)
Mid$(Out2,1,1)=Ucase$(Mid$(Out2,1,1))
Strng="To: "+Out2
Call IO.O
Strng="Subj: "+TableRecord.MessageSubject
Call IO.O
Strng="Time: "+TableRecord.MessageTime
Call IO.O
Strng="Msg#:"+Str$(Temp)+" of"+Str$(Lof(1)/Len(TableRecord))
Call IO.O
If TempF$<>Nul Then
Strng="Text substring found in line"+Str$(Temp3)+":"
Call IO.O
Strng=MessageRecord.Message
VarX=Instr(Strng,Chr$(1))
If VarX Then
Strng=Left$(Strng,VarX-1)
Endif
Strng=Rtrim$(Strng)
Call IO.O
Endif
Call More.Prompt
If No Then
Exit Do
Endif
Endif
Next
Exit Do
Case "Q"
Exit Sub
End Select
Loop
Loop
10421
Exit Sub
10422
Resume 10421
End Sub
Sub Undelete.Message
On Local Error Goto 10452
Do
Temp3=Lof(1)/Len(TableRecord)
Strng="Message number to undelete(1-"+Mid$(Str$(Temp3),2)+")?"
No.Input.Out="1"
Call IO.I
Temp=Val(Out2)
If Temp<1 Or Temp>Temp3 Then
Strng=Range$
Call IO.O
Else
Get 1,Temp,TableRecord
If TableRecord.MessageKilled="F" Then
Strng="Message"+Str$(Temp)+" is not deleted."
Call IO.O
Else
TableRecord.MessageKilled="F"
Put 1,Temp,TableRecord
Strng="Message"+Str$(Temp)+" undeleted."
Call IO.O
Endif
Endif
Graphics.Off=False
Strng="Unelete more messages(y/n)?"
Line.Length=TempD
No.Input.Out="Y"
Call IO.I
If No Then
Exit Do
Endif
Loop
10451
Exit Sub
10452
Resume 10451
End Sub
Sub List.Bases
On Local Error Goto 10462
Graphics.Off=True
Temp1=False
For Temp=1 To Lof(12)/Len(MessageBaseRecord)
Get 12,Temp,MessageBaseRecord
If Left$(MessageBaseRecord.BaseMessName,9)=Deleted$ Then
Strng="#"+Mid$(Str$(Temp),2)+": deleted."
Call IO.O
Else
Out2=MessageBaseRecord.BaseMessName
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
Strng="#"+Mid$(Str$(Temp),2)+": "+Out2+", Type: "
If MessageBaseRecord.BaseType And Public.Base Then
Strng=Strng+"(public) "
Endif
If MessageBaseRecord.BaseType And Private.Base Then
Strng=Strng+"(private) "
Endif
If MessageBaseRecord.BaseType And DM.Base Then
Strng=Strng+"(DMs only) "
Endif
If MessageBaseRecord.BaseType And Sysop.Base Then
Strng=Strng+"(Sysops only) "
Endif
If MessageBaseRecord.BaseType And TownMayor.Base Then
Strng=Strng+"(Town Mayor) "
Endif
If MessageBaseRecord.BaseType And Governor.Base Then
Strng=Strng+"(Governor) "
Endif
If MessageBaseRecord.BaseType And GuildMaster.Base Then
Strng=Strng+"(Guild Master) "
Endif
Strng=Rtrim$(Strng)
Call IO.O
Temp1=Temp1+1
If Temp1>22 Then
Temp1=False
Call More.Prompt
If No Then
Exit For
Endif
Endif
Endif
Next
If Temp1 Then
Call More.Prompt
Endif
10461
Exit Sub
10462
Resume 10461
End Sub
Sub Search.Bases
On Local Error Goto 10472
TempA=False
TempA$=Nul
TempB$=Nul
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]message base name"
If TempA$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempA$+")"
Endif
Call IO.O
Strng="[B]message base filename"
If TempB$<>Nul Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"("+TempB$+")"
Endif
Call IO.O
Strng="[C]message base type"
If TempA Then
Strng=Strng+Space$(30-Len(Strng))
Strng=Strng+"(type:"+Str$(TempA)+")"
Endif
Call IO.O
Graphics.Off=False
Endif
Strng="Message base search option(s to search, q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Graphics.Off=False
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Message base name substring?"
Call IO.I
TempA$=Ucase$(Out2)
Case "B"
Strng="Message base filename(8 letter DOS)?"
Call IO.I
TempB$=Ucase$(Out2)
Case "C"
Do
Call Display.BaseTypes
Strng="Message base type option(q to quit)?"
Line.Length=TempD
No.Input.Out="Q"
Call IO.I
If Ucase$(Out2)="Q" Then
Exit Do
Endif
Temp=Val(Out2)
Select Case Temp
Case 1
TempA=TempA Or Public.Base
Case 2
TempA=TempA Or Private.Base
Case 3
TempA=TempA Or DM.Base
Case 4
TempA=TempA Or Sysop.Base
Case 5
TempA=TempA Or TownMayor.Base
Case 6
TempA=TempA Or Governor.Base
Case 7
TempA=TempA Or GuildMaster.Base
Case 8
TempA=False
End Select
Loop
Case "S"
Strng="Searching message bases."
Call IO.O
Temp6=False
Graphics.Off=True
For Temp=1 To Lof(12)/Len(MessageBaseRecord)
Get 12,Temp,MessageBaseRecord
Temp2=False
If TempA$<>Nul Then
If Instr(MessageBaseRecord.BaseMessName,TempA$) Then
Temp2=True
Endif
Endif
If TempB$<>Nul Then
If Rtrim$(MessageBaseRecord.BaseFileName)=TempB$ Then
Temp2=True
Endif
Endif
If TempA Then
If MessageBaseRecord.BaseType=TempA Then
Temp2=True
Endif
Endif
If Temp2 Then
Graphics.Off=True
Out2=MessageBaseRecord.BaseMessName
Out2=Rtrim$(Out2)
Out2=Lcase$(Out2)
Strng="Message base number"+Str$(Temp)+": "+Out2
Call IO.O
Temp6=Temp6+1
If Temp6>22 Then
Temp6=False
Call More.Prompt
If No Then
Exit Sub
Endif
Endif
Endif
Next
If Temp6 Then
Call More.Prompt
Endif
TempA=False
TempA$=Nul
TempB$=Nul
Case "Q"
Exit Do
End Select
Loop
10471
Exit Sub
10472
Resume 10471
End Sub
Sub Edit.Message(Var)
On Local Error Goto 10482
Do
Graphics.Off=True
If TempC=False Then
Strng="[A]bort"
Call IO.O
Strng="[C]ontinue"
Call IO.O
Strng="[D]elete"
Call IO.O
Strng="[E]dit"
Call IO.O
Strng="[I]nsert"
Call IO.O
Strng="[L]ist"
Call IO.O
Strng="[R]eplace"
Call IO.O
Graphics.Off=False
Endif
Line.Length=TempD
No.Input.Out="S"
Strng="Message edit option(s to store)?"
Call IO.I
Select Case Ucase$(Out2)
Case "A"
Strng="Are you sure(y/n)?"
No.Input.Out="N"
Call IO.I
If Yes Then
Var=0
Exit Do
Endif
Case "C"
Var=-1
Exit Do
Case "D"
Call Delete.Line
Case "E"
Call Edit.Line
Case "I"
Call Insert.Lines
Case "L"
Call List.Lines
Case "R"
Call Replace.Line
Case "S"
Var=1
Exit Do
End Select
Loop
10481
Exit Sub
10482
Resume 10481
End Sub
Sub List.Lines
On Local Error Goto 10484
Line.Length=1
No.Input.Out="Y"
Strng="Display line numbers(y/n)?"
Call IO.I
If Yes Then
TempX=True
Else
TempX=False
Endif
Graphics.Off=True
For Temp=1 To Message.Length
Strng=Nul
If TempX Then
Strng=Right$(Str$(Temp+10),1)+":"
Endif
Strng=Strng+Temp.ArrayS(Temp)
Strng=Left$(Strng,79)
Call IO.O
Next
Call More.Prompt
10483
Exit Sub
10484
Resume 10483
End Sub
Sub Replace.Line
On Local Error Goto 10492
Strng="Line number?"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Message.Length Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="Replacement line:"
Call IO.O
Strng="?"
Call IO.I
Temp.ArrayS(Temp)=Out2
Strng="Line number"+Str$(Temp)+" replaced."
Call IO.O
10491
Exit Sub
10492
Resume 10491
End Sub
Sub Edit.Line
On Local Error Goto 10502
Strng="Line number?"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Message.Length Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="Replace what word?"
Call IO.I
Temp$=Out2
Strng="Replace with what word?"
Call IO.I
Temp2$=Out2
If Temp$=Nul Or Temp$=Temp2$ Then
Strng="No changes made."
Call IO.O
Exit Sub
Endif
Temp2=False
Temp1=Instr(Temp.ArrayS(Temp),Temp$)
Do While Temp1
If Temp2=1 Then
Strng="Replace all words?"
Call IO.I
If No Then
Exit Do
Endif
Endif
Temp.ArrayS(Temp)=Left$(Temp.ArrayS(Temp),Temp1-1)+_
Temp2$+Mid$(Temp.ArrayS(Temp),Temp1+Len(Temp$))
Temp.ArrayS(Temp)=Left$(Temp.ArrayS(Temp),80)
Temp2=Temp2+1
Temp1=Instr(Temp.ArrayS(Temp),Temp$)
Loop
Strng="No changes made."
If Temp2 Then
Strng="Changed"+Str$(Temp2)+" words."
Endif
Call IO.O
10501
Exit Sub
10502
Resume 10501
End Sub
Sub Delete.Line
On Local Error Goto 10512
Strng="From line number(1-"+Mid$(Str$(Message.Length),2)+")?"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Message.Length Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Strng="To line number("+Mid$(Str$(Temp),2)+"-"+_
Mid$(Str$(Message.Length),2)+")?"
Call IO.I
Temp2=Int(Val(Out2))
If Temp2<Temp Or Temp2>Message.Length Then
Strng=Range$
Call IO.O
Exit Sub
Endif
For Temp3=1 To Temp2-Temp+1
Message.Length=Message.Length-1
For Temp1=Temp To Message.Length
Temp.ArrayS(Temp1)=Temp.ArrayS(Temp1+1)
Next
Next
If Message.Length=False Then
Strng="No message left."
Call IO.O
Exit Sub
Endif
Strng="Line numbers"+Str$(Temp)+" to"+Str$(Temp2)+" deleted."
Call IO.O
10511
Exit Sub
10512
Resume 10511
End Sub
Sub Insert.Lines
On Local Error Goto 10522
If Message.Length>18 Then
Strng="Message buffer full."
Call IO.O
Exit Sub
Endif
Strng="Before line number?"
Call IO.I
Temp=Int(Val(Out2))
If Temp<1 Or Temp>Message.Length Then
Strng=Range$
Call IO.O
Exit Sub
Endif
Graphics.Off=True
Do While Message.Length<19
Word.Wrap=True
Strng="?"
Call IO.I
Word.Wrap=False
If No.Input Then
Exit Do
Endif
For Temp1=Message.Length To Temp Step -1
Temp.ArrayS(Temp1+1)=Temp.ArrayS(Temp1)
Next
Temp.ArrayS(Temp)=Out2
Temp=Temp+1
Message.Length=Message.Length+1
Loop
Graphics.Off=False
If Message.Length=19 Then
Strng="Message buffer full."
Call IO.O
Endif
Call More.Prompt
10521
Exit Sub
10522
Resume 10521
End Sub
Sub Store.Message
On Local Error Goto 10532
Strng="Storing message.."
Call IO.O
TableRecord.MessageTime=FNclock$
TableRecord.MessageFrom=Strng3
TableRecord.MessageKilled="F"
TableRecord.MessageTo=Message.To
TableRecord.MessageSubject=Subject
TableRecord.MessageLength=Message.Length+1
TableRecord.MessageStart=Lof(2)/Len(MessageRecord)+1
Put 1,Lof(1)/Len(TableRecord)+1,TableRecord
Strng="Stat: "+Message.Stat
MessageRecord.Message=Left$(Strng,79)+Chr$(1)
Put 2,Lof(2)/Len(MessageRecord)+1,MessageRecord
For Temp=1 To Message.Length
MessageRecord.Message=Left$(Temp.ArrayS(Temp),79)+Chr$(1)
Put 2,Lof(2)/Len(MessageRecord)+1,MessageRecord
Next
10531
Exit Sub
10532
Resume 10531
End Sub
Sub Open.Mail
On Local Error Goto 10542
Close 1, 2
FileName=Config3(54)+TempX$+".TBL"
Open FileName For Random Shared As #1 Len=Len(TableRecord)
FileName=Config3(54)+TempX$+".DAT"
Open FileName For Random Shared As #2 Len=Len(MessageRecord)
10541
Exit Sub
10542
Resume 10541
End Sub
Sub New.Stats
On Local Error Goto 10560
10551
Temp#=Cdbl(Training.Room(UserRecord.ClassType,1))*Cdbl(UserRecord.Level)
10552
If Temp#>MaxInt Then
Temp#=MaxInt
Endif
10553
UserRecord.FatigueMax=Cint(Temp#)
10554
Temp#=Cdbl(Training.Room(UserRecord.ClassType,2))*Cdbl(UserRecord.Level)
If Temp#>MaxInt Then
Temp#=MaxInt
Endif
10555
UserRecord.VitalityMax=Cint(Temp#)
10556
Temp#=Cdbl(Training.Room(UserRecord.ClassType,3))*Cdbl(UserRecord.Level)
If Temp#>MaxInt Then
Temp#=MaxInt
Endif
10557
UserRecord.MagicMax=Cint(Temp#)
10558
Temp#=Cdbl(Training.Room(UserRecord.ClassType,4))*Cdbl(UserRecord.Level)
If Temp#>MaxInt Then
Temp#=MaxInt
Endif
UserRecord.PsionicMax=Cint(Temp#)
If UserRecord.Fatigue<False Or_
UserRecord.Fatigue>UserRecord.FatigueMax Then
UserRecord.Fatigue=UserRecord.FatigueMax
Endif
If UserRecord.Vitality<False Or_
UserRecord.Vitality>UserRecord.VitalityMax Then
UserRecord.Vitality=UserRecord.VitalityMax
Endif
If UserRecord.Magic<False Or_
UserRecord.Magic>UserRecord.MagicMax Then
UserRecord.Magic=UserRecord.MagicMax
Endif
If UserRecord.Psionic<False Or_
UserRecord.Psionic>UserRecord.PsionicMax Then
UserRecord.Psionic=UserRecord.PsionicMax
Endif
If Config2(48) Then
If UserRecord.Level>=10 Then
If UserRecord.ClassType>=1 And UserRecord.ClassType<=10 Then
Out2=High.Class.Name(UserRecord.ClassType)
Call Valid(Out2,20)
If Out2=Nul Then
Strng="Illegal characters in high classname."
Call IO.O
Else
Call Encrypt(Out2,True)
UserRecord.ClassName=Out2
Endif
Endif
Endif
Endif
10559
Exit Sub
10560
If Erl=10551 Then
Resume 10552
Endif
If Erl=10553 Then
Resume 10554
Endif
If Erl=10555 Then
Resume 10556
Endif
If Erl=10557 Then
Resume 10558
Endif
Resume 10559
End Sub
Sub Top.Ten
On Local Error Goto 10564
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 "+FNclock$+"."
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
10561 TempA#=UserRecord.PlayersKilled*UserRecord.Level*2+_
UserRecord.MonstersKilled*UserRecord.Level
10562 Temp.ArrayZ(TempZ)=TempA#
Endif
Endif
Endif
Next
' metzner sort
TempQ=4
While TempQ<=TempZ
TempQ=TempQ*2
Wend
TempQ=Int((TempQ-1)/2)
While TempQ>False
For Var=1 To TempZ-TempQ
VarX=Var
While VarX>False
If Temp.ArrayZ(VarX)<Temp.ArrayZ(VarX+TempQ) Then
Swap Temp.Array1(VarX),Temp.Array1(VarX+TempQ)
Swap Temp.ArrayZ(VarX),Temp.ArrayZ(VarX+TempQ)
VarX=VarX-TempQ
Else
VarX=False
Endif
Wend
Next
TempQ=Int(TempQ/2)
Wend
' end sort
If TempZ>10 Then
TempZ=10
Endif
Strng="Username Level Classname Ranking"
Call IO.O
Strng=String$(64,"-")
Call IO.O
TempX=False
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
Next
If TempX=False Then
Strng="No users have top scores."
Call IO.O
Endif
Redim Temp.Array1(1) As Integer,_
Temp.ArrayZ(1) As Double
Call More.Prompt
10563
Exit Sub
10564
If Erl=10561 Then
Resume 10562
Endif
Resume 10563
End Sub
Sub More.Prompt
On Local Error Goto 10572
Graphics.Off=False
Strng=More$
No.Echo=True
Line.Length=1
Call IO.I
No.Echo=False
10571
Exit Sub
10572
Resume 10571
End Sub
Sub Valid(Var$,Var)
On Local Error Goto 10582
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
10581
Exit Sub
10582
Resume 10581
End Sub
Sub Encrypt(Var$,Var)
On Local Error Goto 10592
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$
10591
Exit Sub
10592
Resume 10591
End Sub
Sub Decrypt(Var$)
On Local Error Goto 10602
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$
10601
Exit Sub
10602
Resume 10601
End Sub
