Server disconnection and crashing problems.

[justin.miller423]

Hello,
I was wondering if someone could help me fix a small issue. This mud server or telnet server if you will doesn't keep the connections alive after a while.
I was wondering if someone could help fix either a memory leak or some other problem I'm overlooking.
I'm not good with memory access stuff yet but the program seems to hold on for around 13 hours since I got it to send an "'" string but when the last connection is lost it crashes the server completely and I think it has something to do with the list but even running locally there's a problem this is why I figured it was a memory issue.
Here is the complete code.

Code: Select all

EnableExplicit


Structure Person
  Name.s
  rank.i
  Gender.i
  Password.s
  PassTries.i
  Email.s
  health.i
  strength.i
  vitality.i
  moves.i
  CNum.i
  LastData.i
  ElTime.i
  PFlag.b
  Text.s
  command.s
  LastTell.s
  KeepAlive.b
  QFlag.b
  Logged.b
EndStructure

Global NewList Players.Person()
Global MudName.s
Global MaxPlayers.i
Global port.i
Global Exit.b


Procedure MsgAll(name.s, msg.s, logged.b = #True)
  ForEach Players()
    If logged
      If name <> Players()\Name And Players()\Logged
      SendNetworkString(Players()\CNum, msg + #CR$)
    EndIf
    Else
      If name <> Players()\Name
      SendNetworkString(Players()\CNum, msg + #CR$)
    EndIf
  EndIf
  Next
EndProcedure
Procedure Timer(*Person.Person)
*Person\ElTime = AddDate(Date(), #PB_Date_Minute, 1)  
  
EndProcedure

Procedure Test(*Person.Person)
  SendNetworkString(*Person\CNum, "Current directory is: " + GetCurrentDirectory())
EndProcedure

Procedure Time(*Person.Person)
  Protected dom.s = " " +Str(Day(Date())) + ", "
  Protected mth.s
  If Month(Date()) = 1
    mth = " January "
  ElseIf Month(Date()) = 2
    mth = " February "
  ElseIf Month(Date()) = 3
    mth = " March "
  ElseIf Month(Date()) = 4
    mth = " April "
  ElseIf Month(Date()) = 5
    mth = " May "
  ElseIf Month(Date()) = 6
    mth = " June "
  ElseIf Month(Date()) = 7
    mth = " July "
  ElseIf Month(Date()) = 8
    mth = " August "
  ElseIf Month(Date()) = 9
    mth = " September "
  ElseIf Month(Date()) = 10
    mth = " October "
  ElseIf Month(Date()) = 11
    mth = " November "
  Else
    mth = " December "
  EndIf
  Protected dw.s
  If DayOfWeek(Date()) = 0
    dw = " Sunday, "
  ElseIf DayOfWeek(Date()) = 1
    dw = " Monday, "
  ElseIf DayOfWeek(Date()) = 2
    dw = " Tuesday, "
  ElseIf DayOfWeek(Date()) = 3
    dw = " Wednesday, "
  ElseIf DayOfWeek(Date()) = 4
    dw = " Thursday, "
  ElseIf DayOfWeek(Date()) = 5
    dw = " Friday, "
  Else
    dw = " Saturday, "
  EndIf
  Protected hr.s = Str(Hour(Date()))
  If Hour(Date()) = 0
    hr = "12"
  EndIf
  Protected mn.s = Str(Minute(Date()))
  Protected dayhour.s
  If Hour(Date()) >= 12
    dayhour = "PM."
    If Hour(Date()) > 12
      hr = Str(Hour(Date()) -12)
    EndIf
  Else
    dayhour = "aAM."
  EndIf
  SendNetworkString(*Person\CNum, "The current server time is: " + dw + mth + dom + Str(Year(Date())) + #CR$ + hr + ":" + mn + " " + dayhour + #CR$)
EndProcedure

Procedure Tell(*Person.Person)
  Protected x.i = 0
  Protected kick.s = ""
  Protected who.s = ""
  For x = 1 To CountString(*Person\Text, " ") + 1
    If x = 2
      who = StringField(*Person\Text, x, " ")
    ElseIf x > 2
      kick = kick + StringField(*Person\Text, x, " ") + " "
    EndIf
  Next
  If who = ""
    SendNetworkString(*Person\CNum, "You must type <tell> <playername> <message>." + #CR$)
    ProcedureReturn
  EndIf
  If who = *Person\Name
    SendNetworkString(*Person\CNum, "You can't tell yourself." + #CR$)
    ProcedureReturn
  EndIf
  ForEach Players()
    If Players()\Name = who
      SendNetworkString(*Person\CNum, "You tell " + Players()\Name + ", " + kick + #CR$)
      SendNetworkString(Players()\CNum, *Person\Name+ " tells you, " + kick + #CR$)
      Players()\LastTell = *Person\Name
      ProcedureReturn
    EndIf
    Next
    SendNetworkString(*Person\CNum, "This player does not exist." + #CR$)
EndProcedure

Procedure Reply(*Person.Person)
  Protected x.i = 0
  Protected kick.s = ""
  For x = 2 To CountString(*Person\Text, " ") + 1
    kick = kick + StringField(*Person\Text, x, " ") + " "
  Next
  If kick = ""
    SendNetworkString(*Person\CNum, "You must type <reply> <message>." + #CR$)
    ProcedureReturn
  EndIf
  ForEach Players()
    If Players()\Name = *Person\LastTell
      SendNetworkString(*Person\CNum, "You tell " + Players()\Name + ", " + kick + #CR$)
      SendNetworkString(Players()\CNum, *Person\Name+ " tells you, " + kick + #CR$)
      Players()\LastTell = *Person\Name
      ProcedureReturn
    EndIf
  Next
  SendNetworkString(*Person\CNum, "This player does not exist." + #CR$)
EndProcedure

Procedure motd(*Person.Person)
  Protected f.i
  Protected RString.s
  OpenFile(0, "motd.txt")
    f = ReadFile(#PB_Any, "motd.txt")
    SendNetworkString(*Person\CNum, "MOTD:" + #CR$)
    While Eof(f) = 0
      RString = ReadString(f)
      SendNetworkString(*Person\CNum,  RString + #CR$)
    Wend
  CloseFile(0)
EndProcedure

Procedure Register(*Person.Person)
  ForEach Players()
    If Players() <> *Person And *Person\Name = Players()\Name
      Players()\QFlag = #True
      Break
    EndIf
  Next
  Protected RString.s
  Protected f.i
    If *Person\Logged = #True
      MsgAll(*Person\Name, *Person\Name + " has entered the game.")
      SendNetworkString(*Person\CNum, "Welcome To " + MudName + "! Type help For the List of commands. The current message of the day is:" + #CR$)
      PrintN(*Person\Name + " has just logged in.")
      OpenFile(0, "motd.txt")
        f = ReadFile(#PB_Any, "motd.txt")
        While Eof(f) = 0
          RString = ReadString(f)
          SendNetworkString(*Person\CNum,  RString + #CR$)
        Wend
      CloseFile(0)
    EndIf
    *Person\PFlag = #True
    Timer(*Person)
    *Person\command = "game"
  Time(*Person)
EndProcedure

Procedure.s StrGender(*Person.Person)
  If *Person\Gender = 1
    ProcedureReturn "male"
  ElseIf *Person\Gender = 2
    ProcedureReturn "female"
  EndIf
EndProcedure

Procedure Gender(*Person.Person)
  If *Person\Text = ""
    SendNetworkString(*Person\CNum, "Please choose your gender." + #CR$ + "1 for male or 2 for female." + #CR$)
    ProcedureReturn
  EndIf
  If Val(*Person\Text) > 0 And Val(*Person\Text) < 3
    *Person\Gender = Val(*Person\Text)
    SendNetworkString(*Person\CNum, "You are now a " + StrGender(*Person) + "." + #CR$)
    *Person\rank = 1
    *Person\health = 10000
    *Person\strength = 3
    *Person\vitality = 3
    *Person\moves = 3
    *Person\Logged = #True
    Register(*Person)
  Else
    SendNetworkString(*Person\CNum, "You must choose either 1 for male or 2 for female." + #CR$)
  EndIf
EndProcedure

Procedure Name(*Person.Person)
  If *Person\Text = ""
    SendNetworkString(*Person\CNum, "Please type your chosen name.")
    ProcedureReturn
  EndIf
  Protected f.i
  Protected RString.s
  If FileSize("players\"+*Person\Text+".plr") > -1
    f = ReadFile(#PB_Any, "players/" + *Person\Text+".plr")
      RString = ReadString(f)
      *Person\Name = RString
      RString = ReadString(f)
      *Person\rank = Val(RString)
      RString = ReadString(f)
      *Person\Password = RString
      RString = ReadString(f)
      *Person\Gender = Val(RString)
      RString = ReadString(f)
      *Person\health = Val(RString)
      RString = ReadString(f)
      *Person\strength = Val(RString)
      RString = ReadString(f)
      *Person\vitality = Val(RString)
      RString = ReadString(f)
      *Person\moves = Val(RString)
      SendNetworkString(*Person\CNum, "The character " + *Person\Text + " already exists." + #CR$)
    CloseFile(f)
  Else
    *Person\Name = *Person\Text
    SendNetworkString(*Person\CNum, "Welcome, " + *Person\Name + "." + #CR$)
  EndIf
  *Person\command = "password"
  If *Person\Password <> ""
    SendNetworkString(*Person\CNum, "Please type the existing password For " + *Person\Name + ".")
  Else
    SendNetworkString(*Person\CNum, "Please type the new password For " + *Person\Name + ".")
  EndIf
EndProcedure

Procedure Boot(*Person.Person)
  Protected x.i = 0
  Protected kick.s = ""
  Protected who.s = ""
  For x = 1 To CountString(*Person\Text, " ") + 1
    If x = 2
      who = StringField(*Person\Text, x, " ")
    ElseIf x > 2
      kick = kick + StringField(*Person\Text, x, " ") + " "
    EndIf
  Next
  If who = ""
    SendNetworkString(*Person\CNum, "You must type <boot> <playername> <reason> optional." + #CR$)
    ProcedureReturn
  EndIf
  ForEach Players()
    If Players()\Name = who And *Person\rank >= Players()\rank
      SendNetworkString(*Person\CNum, Players()\Name + " has been kicked." + #CR$)
      SendNetworkString(Players()\CNum, "You have been kicked by " + *Person\Name + " for the following reason: " + kick + #CR$)
      Players()\QFlag = #True
      ProcedureReturn
    ElseIf *Person\rank < Players()\rank
      SendNetworkString(*Person\CNum, "You do not have the authority to boot " + who + " from the server." + #CR$)
      ProcedureReturn
    EndIf
  Next
  SendNetworkString(*Person\CNum, "This player does not exist." + #CR$)
EndProcedure
  
Procedure Password(*Person.Person)
  If *Person\command = "password" And *Person\Password <> ""
    If *Person\Text = ""
      SendNetworkString(*Person\CNum, "Please type the existing password For " + *Person\Name + ".")
      ProcedureReturn
    EndIf
    If *Person\Text <> *Person\Password
      *Person\PassTries = *Person\PassTries +1
      If *Person\PassTries  = 3        
        SendNetworkString(*Person\CNum, "You have made too many attempts to connect to this account and will be kicked from the server." + #CR$)
        *Person\QFlag = #True
        ProcedureReturn
      EndIf
      SendNetworkString(*Person\CNum, "The password you entered is incorrect." + #CR$ + "Please retype the password.")
    Else
      *Person\Logged = #True
      Register(*Person)
    EndIf
  ElseIf *Person\command = "password" And *Person\Password = ""
    If *Person\Text = ""
      SendNetworkString(*Person\CNum, "Please type the new password For " + *Person\Name + ".")
      ProcedureReturn
    EndIf
    *Person\Password = *Person\Text
    *person\command = "repassword"
    SendNetworkString(*Person\CNum, "Now please retype your password.")
    ElseIf *Person\command = "repassword" And *Person\Password <> ""
    If *Person\Text = ""
      SendNetworkString(*Person\CNum, "Now please retype your password.")
      ProcedureReturn
    EndIf
    If *Person\Text <> *Person\Password
      SendNetworkString(*Person\CNum, "Passwords do not match." + #CR$ + "Please retype your password.")
      *Person\Password = ""
      *Person\command = "password"
    Else
      *person\command = "gender"
      SendNetworkString(*Person\CNum, "Please choose your gender." + #CR$ + "1 for male or 2 for female." + #CR$)
    EndIf
  EndIf
EndProcedure

Procedure SaveFile(*Person.Person)
  Protected f.i
  CreateFile(f, "players/" + *Person\Name+".plr")
  WriteStringN(f, *Person\Name + #CR$ + *Person\rank + #CR$ + *Person\Password + #CR$ + Str(*Person\Gender) + #CR$ + Str(*Person\health) + #CR$ + Str(*Person\strength) + #CR$ + Str(*Person\vitality) + #CR$ + Str(*Person\moves))
  CloseFile(f)
EndProcedure

Procedure RFile(*Person.person)
  Protected RString.s
  Protected f.i
  If FileSize("players\" + *Person\Name + ".plr") > -1
    f = ReadFile(#PB_Any, "players/" + *Person\Name+".plr")
      SendNetworkString(*Person\CNum,  "Here is the file in its entirety." + #CR$)
      While Eof(f) = 0
        RString = ReadString(f)
        SendNetworkString(*Person\CNum,  RString + #CR$)
      Wend
    CloseFile(f)
  Else
    SendNetworkString(*Person\CNum, "Your data file does not exist yet. Please type save.")
  EndIf
EndProcedure

Procedure Who(*Person.Person)
  Protected c = 0
  Protected people.s = ""
  ForEach Players()
    If Players()\Logged= #True
      c = c + 1
    EndIf
  Next
  SendNetworkString(*Person\CNum, "There are " + c + " players who are online:" + #CR$)
  ForEach Players()
    If Players()\Logged = #True
      people = people + Players()\Name + #CR$
    EndIf
  Next
  SendNetworkString(*Person\CNum, people + #CR$)
  *Person\Text = ""
EndProcedure

Procedure Quit(*Person.Person)
  SendNetworkString(*Person\CNum, "Goodbye " + *Person\Name + ". Thanks For checking out " + MudName + "." + #CR$)
  *Person\QFlag = #True
  Delay(10)
EndProcedure

Procedure help(*Person.Person)
  SendNetworkString(*Person\CNum, "The game is still being developed so test functions are a must." + #CR$)
  SendNetworkString(*Person\CNum, "Type info to get information about the game,"+ #CR$)
  SendNetworkString(*Person\CNum, "stats to see info about you," + #CR$)
  SendNetworkString(*Person\CNum, "who to find out how many people are online," + #CR$)
  SendNetworkString(*Person\CNum, "shutdown To completely shut down the server,"+ #CR$)
  SendNetworkString(*Person\CNum, "quit to close the connection and delete your player info,"+ #CR$)
  SendNetworkString(*Person\CNum, "or help for this help information."+ #CR$)
EndProcedure

Procedure say(*Person.Person)
  Protected SayMsg.s
  SendNetworkString(*Person\CNum, "You say: " + Right(*Person\Text, Len(*Person\Text) -4) + #CR$)
  SayMsg = Right(*Person\Text, Len(*Person\Text) -4)
  ForEach Players()
    If Players()\Name = *Person\Name Or Players()\Logged = #False
      Continue
    EndIf
    SendNetworkString(Players()\CNum, *Person\Name + " says: " + SayMsg + #CR$)
  Next
EndProcedure

Procedure shutdown(*Person.Person)
  Protected SayMsg.s
  SayMsg = Right(*Person\Text, Len(*Person\Text) -9)
  ForEach Players()
    SendNetworkString(Players()\CNum, "Server shutdown initiated by " + *Person\Name + " for the following reason: " + SayMsg + #CR$)
    Quit(Players())
  Next
EndProcedure

Procedure info(*Person.Person)
  SendNetworkString(*Person\CNum, "Dark ages written by Justin Miller." + #CR$)
  SendNetworkString(*Person\CNum, "copyright 2018 by Justin Miller." + #CR$)
  *Person\Text = ""
EndProcedure

Procedure NetworkConnectEvent(cnt.i) 
  Protected *Person.Person
 
  If MaxPlayers = ListSize(Players())
    SendNetworkString(cnt, "Max clients are reached!")
    Print("Max clients are reached!")
  Else
    ForEach Players()
      If Players()\CNum = cnt
        *Person = Players()
      EndIf
    Next
    If *Person = #Null
      *Person = AddElement(Players())
      
      *Person\CNum = cnt
      *Person\LastData = Date()
      *Person\command = "registering"
    EndIf
    Delay(500)
    SendNetworkString(cnt, "Welcome to " + MudName + ". " + #CR$ + "This game is under development." + #CR$)
    PrintN("A client has connected with the ip " + IPString(GetClientIP(cnt)) + ".")
    If *person\Name = ""
      Name(*Person)
    EndIf
  EndIf
EndProcedure

Procedure NetworkDataEvent(cnt.i) 
  Protected.i received
  Protected *data
  Protected *Person.Person
  ForEach Players()
    If Players()\CNum = cnt
      *Person = Players()
    EndIf
  Next
  If *Person = #Null
    *Person = AddElement(Players())
    *Person\CNum = cnt
  EndIf
  *Person\LastData = Date()
  *data = AllocateMemory(4096, #PB_Memory_NoClear)
  If *data
    received = ReceiveNetworkData(cnt, *data, MemorySize(*Data))
    If received > 0
      *Person\Text = PeekS(*data, received, #PB_UTF8|#PB_ByteLength)
      *Person\Text = Left(*Person\Text, Len(*Person\Text) - 2)
      If *Person\command = "game"
        Protected cmd.s = StringField(*Person\Text, 1, " ")
        *Person\Text = ReplaceString(*Person\Text, cmd, LCase(cmd))
        If Left(*Person\Text, 3) = "say"
          say(*Person)
        ElseIf *Person\Text = "test"
          Test(*Person)
        ElseIf *Person\Text = "prompt"
          If *Person\PFlag = #False
            *Person\PFlag = #True
            SendNetworkString(*Person\CNum, "Your prompt has been turned on." + #CR$)
          ElseIf *Person\PFlag
            *Person\PFlag = #False
          SendNetworkString(*Person\CNum, "Your prompt has been turned off." + #CR$)
        EndIf
      ElseIf Left(*Person\Text, 4) = "time"
          Time(*Person)
        ElseIf Left(*Person\Text, 8) = "announce"
          MsgAll(*Person\Name, *Person\Name + " has made an announcement." + #CR$ + Right(*Person\Text, Len(*Person\Text) -9), #True)
          SendNetworkString(*Person\CNum, "Your announcement was sent.")
        ElseIf Left(*Person\Text, 4) = "tell"
          Tell(*Person)
        ElseIf Left(*Person\Text, 5) = "reply"
          Reply(*Person)
        ElseIf Left(*Person\Text, 4) = "boot"
          If *Person\rank < 3
            SendNetworkString(*Person\CNum, "You do not have permission to use this command.")
            ProcedureReturn
          EndIf
          Boot(*Person)
        ElseIf *Person\Text = "motd"
          motd(*Person)
        ElseIf *Person\Text = "save"
          SaveFile(*Person)
          SendNetworkString(*Person\CNum, "Your player info has been saved.")
        ElseIf *Person\Text = "keepalive"
          If *Person\KeepAlive = 0
            *Person\KeepAlive = 1
            SendNetworkString(*Person\CNum, "Your keep alive flag is now on and you will not be disconnected from the server." + #CR$)
          ElseIf *Person\KeepAlive = 1
            *Person\KeepAlive = 0
            SendNetworkString(*Person\CNum, "Your keep alive flag has been turned off. After 3 minutes of inactivity you will be disconnected." + #CR$)
            *Person\LastData = Date()
          EndIf
        ElseIf *Person\Text = "rf"
          RFile(*Person)
        ElseIf *Person\Text = "stats"
          SendNetworkString(*Person\CNum, "You are " + *Person\Name + " rank " + *Person\rank + #CR$)
          SendNetworkString(*Person\CNum, " You are " + StrGender(*Person) + #CR$)
          SendNetworkString(*Person\CNum, " You have " + *Person\health + " health, " + #CR$ + *Person\strength + " strength, " + *Person\vitality + " vitality, and " + *Person\moves + " moves." + #CR$)
        ElseIf *Person\Text = "who"
          Who(*Person)
        ElseIf Left(*Person\Text, 8) = "shutdown"
          If *Person\rank < 5
            SendNetworkString(*Person\CNum, "You may not use this command because you are not the server administrator.")
            ProcedureReturn
          EndIf
          *Person\command = "shutdown"
          shutdown(*Person)
          Exit = #True
        ElseIf *Person\Text = "info"
          info(*Person)
        ElseIf *Person\Text = "quit"
          Quit(*Person)
        ElseIf *Person\Text = "help"
          help(*Person)
        Else
          SendNetworkString(*Person\CNum, "Huh?" + #CR$)
        EndIf
      ElseIf *Person\command = "registering"
        Name(*Person)
      ElseIf *Person\command = "password"
        Password(*Person)
      ElseIf *Person\command = "repassword"
        Password(*Person)
      ElseIf *Person\command = "gender"
        Gender(*Person)
      EndIf
      If Players()\Logged And Players()\PFlag
        SendNetworkString(*Person\CNum, Str(*Person\health) + "health, " + Str(*Person\strength) + "strength, " + Str(*Person\vitality) + "vitality, " + Str(*Person\moves) + "moves")
      EndIf
      *Person\Text = ""
      FreeMemory(*data)
    EndIf
  EndIf
EndProcedure

Procedure Main()
  OpenConsole("Server setup")
  Delay(100)
  OpenFile(0, "motd.txt")
  CloseFile(0)
  If FileSize("settings.conf") = -1
    CreateFile(0, "settings.conf")
      Print ("What's the maximum number of players allowed to connect to the server?")
      MaxPlayers = Val(Input())
      If MaxPlayers < 1
        PrintN("Default: The Default maximum players allowed is 3.")
        MaxPlayers = 3
      EndIf
      Print ("Please enter a name for your game.")
      MudName = Input()
      ConsoleTitle(MudName)
      Print ("Please enter a port number for incomming connections.")
      port = Val(Input())
      If port = 0
        PrintN("Port must have a value. Since nothing was entered the port will be set to 4000 as the default.")
        port = 4000
      EndIf
      WriteStringN(0, Str(MaxPlayers))
      WriteStringN(0, MudName)
      WriteStringN(0, Str(port))
    CloseFile(0)
    PrintN("The server configuration settings have been saved to settings.conf.")
  Else
    OpenFile(0, "settings.conf")
      MaxPlayers = Val(ReadString(0))
      PrintN("Max players is set to: " + Str(MaxPlayers))
      MudName = ReadString(0)
      ConsoleTitle(MudName)
      PrintN("Mud name is set to: " + MudName)
      port = Val(ReadString(0))
      PrintN("Port is set to: " + Str(port))
    CloseFile(0)
  EndIf
  If CreateNetworkServer(0, port, #PB_Network_TCP, "0.0.0.0") = 0
    PrintN("Error: The server could Not be started.")
    End
  EndIf
  PrintN("Server started successfully.")

  Repeat
 
    Inkey()
    If RawKey() = 27
      PrintN("Exit: The server will now close.")
      Exit = #True
    EndIf
 
    Select NetworkServerEvent(0)
      Case #PB_NetworkEvent_Connect
        NetworkConnectEvent(EventClient())
     
      Case #PB_NetworkEvent_Data
        NetworkDataEvent(EventClient())
     
      Case #PB_NetworkEvent_None
        Protected x.i = ListSize(Players())
        Delay(5)
        For x = ListSize(Players()) -1 To 0 Step -1
          SelectElement(Players(), x)        
          If Players()\KeepAlive
            Players()\LastData = Date()
          EndIf        
            If Date() = Players()\ElTime
              SendNetworkString(Players()\CNum, "'")
              Timer(Players())
            EndIf
          If (Players()\QFlag = #True) Or (Players()\LastData < Date() - 180 And Players()\KeepAlive = #False)
            If Players()\QFlag
              MsgAll(Players()\Name, Players()\Name + "has left the game.")
              SelectElement(Players(), x)        
              PrintN("Info: " + Players()\Name + " has chosen to disconnect.")
            Else
            If Players()\Logged = #False
              PrintN("Info: Client " + Str(Players()\CNum) + " disconnected due to inactivity.")
            Else
              PrintN(Players()\Name + " has been disconnected do to inactivity.")
              SendNetworkString(Players()\CNum, "You have been disconnected because you were idle for 3 minutes.")
            EndIf
          EndIf
          CloseNetworkConnection(Players()\CNum)
          DeleteElement(Players())
          If ListSize(Players()) = 0
            ClearList(Players())
          EndIf
        EndIf
      Next
    EndSelect 
  Until Exit
  CloseNetworkServer(0)
EndProcedure

Main()

// Code tags added (Kiffi)

[spikey]

Ok, I can see one potential crash on line 649. You aren't handling #PB_NetworkEvent_Disconnect and you need to. The underlying connection is invalidated by the event and if you subsequently try to access it an IMA will occur. In this case your idle timeout subsequently attempts to close a non-existent connection and crashes.

Clear the Players()\CNum value immediately on receiving #PB_NetworkEvent_Disconnect, and check for a zero CNum before closing in the idle timeout section. (For robustness when scaling to lots of clients, you may need to make a similar check on zero CNum before 'Sending' too).

I changed 649 to look like:

Code: Select all

If Players()\CNum > 0
  CloseNetworkConnection(Players()\CNum)
EndIf

And I added this to the 'Select/Case' at 617:

Code: Select all

Case #PB_NetworkEvent_Disconnect
  NetworkDisconnectEvent(EventClient())

And a new procedure, like this:

Code: Select all

Procedure NetworkDisconnectEvent(cnt.i)
  
  Protected *Person.Person
  
  ForEach Players()
    If Players()\CNum = cnt
      *Person = Players()
      *Person\QFlag = #True
      *Person\CNum = 0
    EndIf
  Next Players()
  
EndProcedure

[justin.miller423]

Hello again and sorry for so many questions but I've never done thread programming and I'm having list issues or something and I can't get the exact errors that cause the server to crash.
A friend and I have been heavily updating it and recently switched back to threads. We are both blind and the debugger isn't all that accessible so I need help working out why this server is crashing.
The crash is hard to reproduce because its random. You might be able to see the crash if I was able to post every file here but since I can't the program has a different file for commands being declared and the players are stored in a database.
Any way here is the main server code. Maybe someone could help me figure out the problem. I even put delays in all of my loops to allow for threads to do what they need to. So far 75 ms. Code is below.
I warn you though, its lengthy.

CompilerIf Not #PB_Compiler_Thread
CompilerError "You have to enable ThreadSafe in Compiler Options!"
CompilerEndIf

EnableExplicit
InitSound()
UseOGGSoundDecoder()
LoadSound(0, "connected.ogg")
UseSQLiteDatabase()
IncludeFile "players.pb"
Declare Editor(*Person.Person)
Declare Speech(speak.s)

Global crlf.s = #CR$ + #LF$
Global SrvTime.i
Global NewList Players.Person()
Global MudName.s
Global MaxPlayers.i
Global port.i
Global mutex.i
Global Exit.b

Procedure Editor(*Person.Person)
SendNetworkString(*Person\CNum, "Welcome To the test editor." + crlf)
SendNetworkString(*Person\CNum, "Enter lines of text." + crlf)
SendNetworkString(*Person\CNum, "Type </r> to print your lines to the output or </done> on a blank line to exit the editor.")
*Person\Command = "editor"
Protected NewList lns.s()
Protected Finished.s
While Finished <> "/done"
Delay(75)
SendNetworkString(*Person\CNum, "Line " + Str(ListSize(lns())+1) + ":" + crlf)
*Person\Text = ""
While *Person\Text = ""
Delay(75)
Wend
If *Person\Text = "/r"
If ListSize(lns()) = 0
SendNetworkString(*Person\CNum, "No lines of text has been entered.")
*Person\Text = ""
EndIf
If ListSize(lns()) > 0
SendNetworkString(*Person\CNum, "The text you have entered is as follows:" + crlf)
Protected x.i
For x = 0 To ListSize(lns()) -1
Delay(75)
SelectElement(lns(), x)
SendNetworkString(*Person\CNum, lns() + crlf)
Next
EndIf
*Person\Text = ""
EndIf
If *Person\Text <> "" Or *Person\Text <> "/done"
If *Person\Text = "/done"
Finished = *Person\Text
EndIf
If *Person\Text <> ""
AddElement(lns())
lns() = *Person\Text
*Person\Text = ""
EndIf
EndIf

Wend
SendNetworkString(*Person\CNum, "Thanks for checking out the test editor.")
*Person\Text = ""
*Person\Command = "game"
EndProcedure


Procedure SaveFile(*Person.Person)
Protected f.i
If OpenDatabase(f, "server.db", "", "") <> 0
SetDatabaseString(f, 0, *Person\Name)
SetDatabaseString(f, 1, *Person\Password)
SetDatabaseLong(f, 2, *Person\rank)
SetDatabaseLong(f, 3, *Person\Gender)
SetDatabaseLong(f, 4, *Person\health)
SetDatabaseLong(f, 5, *Person\strength)
SetDatabaseLong(f, 6, *Person\vitality)
SetDatabaseLong(f, 7, *Person\moves)
SetDatabaseLong(f, 8, *Person\PFlag)
SetDatabaseLong(f, 9, *Person\KeepAlive)
SetDatabaseLong(f, 10, *Person\id)
DatabaseUpdate(f, "UPDATE PLAYERS SET name = ?, password = ?, rank = ?, gender = ?, health = ?, strength = ?, vitality = ?, moves = ?, prompt = ?, keepalive = ? WHERE id = ?")
CloseDatabase(f)
EndIf
EndProcedure

Procedure Speech(speak.s)
SetEnvironmentVariable("SText", speak)
RunProgram("speech.exe")
EndProcedure


Procedure Split(String.s, List StringList.s(), Separator.s = " ")
Protected S.String, *S.Integer = @S
Protected.i p, slen
slen = Len(Separator)
ClearList(StringList())

*S\i = @String
Repeat
AddElement(StringList())
p = FindString(S\s, Separator)
StringList() = PeekS(*S\i, p - 1)
*S\i + (p + slen - 1) << #PB_Compiler_Unicode
Until p = 0
*S\i = 0
EndProcedure

Procedure MsgAll(name.s, msg.s, logged.b = #True)
ForEach Players()
Delay(75)
If logged
If name <> Players()\Name And Players()\Logged
SendNetworkString(Players()\CNum, msg + crlf)
EndIf
Else
If name <> Players()\Name
SendNetworkString(Players()\CNum, msg + crlf)
EndIf
EndIf
Next
EndProcedure


Procedure ConnTime(*Person.Person)
Protected dom.s = " " +Str(Day(*Person\ConTime)) + ", "
Protected mth.s
If Month(*Person\ConTime) = 1
mth = " January "
ElseIf Month(*Person\ConTime) = 2
mth = " February "
ElseIf Month(*Person\ConTime) = 3
mth = " March "
ElseIf Month(*Person\ConTime) = 4
mth = " April "
ElseIf Month(*Person\ConTime) = 5
mth = " May "
ElseIf Month(*Person\ConTime) = 6
mth = " June "
ElseIf Month(*Person\ConTime) = 7
mth = " July "
ElseIf Month(*Person\ConTime) = 8
mth = " August "
ElseIf Month(*Person\ConTime) = 9
mth = " September "
ElseIf Month(*Person\ConTime) = 10
mth = " October "
ElseIf Month(*Person\ConTime) = 11
mth = " November "
Else
mth = " December "
EndIf
Protected dw.s
If DayOfWeek(*Person\ConTime) = 0
dw = " Sunday, "
ElseIf DayOfWeek(*Person\ConTime) = 1
dw = " Monday, "
ElseIf DayOfWeek(*Person\ConTime) = 2
dw = " Tuesday, "
ElseIf DayOfWeek(*Person\ConTime) = 3
dw = " Wednesday, "
ElseIf DayOfWeek(*Person\ConTime) = 4
dw = " Thursday, "
ElseIf DayOfWeek(*Person\ConTime) = 5
dw = " Friday, "
Else
dw = " Saturday, "
EndIf
Protected hr.s = Str(Hour(*Person\ConTime))
If Hour(*Person\ConTime) = 0
hr = "12"
EndIf
Protected mn.s = Str(Minute(*Person\ConTime))
Protected dayhour.s
If Hour(*Person\ConTime) >= 12
dayhour = "PM."
If Hour(*Person\ConTime) > 12
hr = Str(Hour(*Person\ConTime) -12)
EndIf
Else
dayhour = "AM."
EndIf
SendNetworkString(*Person\CNum, "You have been connected since " + dw + mth + dom + Str(Year(*Person\ConTime)) + crlf + hr + ":" + mn + dayhour + crlf)
EndProcedure

Procedure SrvStats(*Person.Person)
Protected dom.s = " " +Str(Day(SrvTime)) + ", "
Protected mth.s
If Month(SrvTime) = 1
mth = " January "
ElseIf Month(SrvTime) = 2
mth = " February "
ElseIf Month(SrvTime) = 3
mth = " March "
ElseIf Month(SrvTime) = 4
mth = " April "
ElseIf Month(SrvTime) = 5
mth = " May "
ElseIf Month(SrvTime) = 6
mth = " June "
ElseIf Month(SrvTime) = 7
mth = " July "
ElseIf Month(SrvTime) = 8
mth = " August "
ElseIf Month(SrvTime) = 9
mth = " September "
ElseIf Month(SrvTime) = 10
mth = " October "
ElseIf Month(SrvTime) = 11
mth = " November "
Else
mth = " December "
EndIf
Protected dw.s
If DayOfWeek(SrvTime) = 0
dw = " Sunday, "
ElseIf DayOfWeek(SrvTime) = 1
dw = " Monday, "
ElseIf DayOfWeek(SrvTime) = 2
dw = " Tuesday, "
ElseIf DayOfWeek(SrvTime) = 3
dw = " Wednesday, "
ElseIf DayOfWeek(SrvTime) = 4
dw = " Thursday, "
ElseIf DayOfWeek(SrvTime) = 5
dw = " Friday, "
Else
dw = " Saturday, "
EndIf
Protected hr.s = Str(Hour(SrvTime))
If Hour(SrvTime) = 0
hr = "12"
EndIf
Protected mn.s = Str(Minute(SrvTime))
Protected dayhour.s
If Hour(SrvTime) >= 12
dayhour = "PM."
If Hour(SrvTime) > 12
hr = Str(Hour(SrvTime) -12)
EndIf
Else
dayhour = "AM."
EndIf
SendNetworkString(*Person\CNum, "Server has been running since " + dw + mth + dom + Str(Year(SrvTime)) + crlf + hr + ":" + mn +dayhour + crlf)

EndProcedure
Procedure Timer(*Person.Person)
*Person\ElTime = AddDate(Date(), #PB_Date_Minute, 1)

EndProcedure

Procedure Test(*Person.Person)
If ListSize(*Person\args()) = 0
SendNetworkString(*Person\CNum, "No arguments were provided.")
ProcedureReturn
EndIf
FirstElement(*Person\args())
ForEach *Person\args()
Delay(75)
SendNetworkString(*Person\CNum, "Argument " + ListIndex(*Person\args()) + " is " + *Person\args() + crlf)
Next

EndProcedure

Procedure DelChar(*Person.Person)
If ListSize(*Person\args()) <= 0
SendNetworkString(*Person\CNum, "Syntax: delchar <player name>.")
ProcedureReturn
EndIf
SelectElement(*Person\args(), 0)
Protected f.i
Protected x.i
OpenDatabase(f, "server.db", "", "")
SetDatabaseString(f, 0, *Person\args())
DatabaseQuery(f, "SELECT name, rank FROM players WHERE name = ?")
If NextDatabaseRow(f) <> 0
Protected delname.s = GetDatabaseString(f, DatabaseColumnIndex(f, "name"))
Protected delrank.i = GetDatabaseLong(f, DatabaseColumnIndex(f, "rank"))
If *Person\rank >= delrank
For x = 0 To ListSize(Players()) -1
Delay(75)
SelectElement(Players(), x)
If Players()\name = delname
SendNetworkString(Players()\CNum, "Your character has been deleted." + crlf)
Players()\QFlag = #True
Break
EndIf
Next
SetDatabaseString(f, 0, *Person\args())
DatabaseUpdate(f, "DELETE FROM players WHERE name = ?")
SendNetworkString(*Person\CNum, "The character " + *Person\args() + " has been deleted." + crlf)
Else
SendNetworkString(*Person\CNum, "You are not a heigh enough rank to delete this character." + crlf)
EndIf
Else
SendNetworkString(*Person\CNum, "This character does not exist." + crlf)
EndIf
FinishDatabaseQuery(f)
CloseDatabase(f)
EndProcedure

Procedure Set(*Person.Person)
Protected PFound.b = #False
If ListSize(*Person\args()) = 0
SendNetworkString(*Person\CNum, "Descriptions for functions will be added here when added to the game.")
ProcedureReturn
EndIf
SelectElement(*Person\args(), 0)
If *Person\args() = "char"
If ListSize(*Person\args()) < 2
SendNetworkString(*Person\CNum, "You must provide a players name.")
ProcedureReturn
EndIf
If ListSize(*Person\args()) < 4
SendNetworkString(*Person\CNum, "The correct format is set <char> <PlayerName> <field> <value>" + crlf)
ProcedureReturn
EndIf
Protected x.i
SelectElement(*Person\args(), 1)
For x = 0 To ListSize(Players()) -1
Delay(75)
SelectElement(Players(), x)
If *Person\args() = Players()\Name
SelectElement(*Person\args(), 2)
If *Person\args() = "rank"
If *Person\rank <= Players()\rank
SendNetworkString(*Person\CNum, "You may not change " + Players()\Name + "'s rank.")
ProcedureReturn
EndIf
SelectElement(*Person\args(), 3)
If Val(*Person\args()) < 1 Or Val(*Person\args()) > 5
SendNetworkString(*Person\CNum, "Value must be between 1 and 5.")
ProcedureReturn
EndIf
Players()\rank = Val(*Person\args())
SendNetworkString(*Person\CNum, "The player " + Players()\Name + " has been set to rank " + Players()\rank + "." +crlf)
If *Person\Name = Players()\Name
PFound = #True
Continue
EndIf
SendNetworkString(Players()\CNum, "Your rank has been set to " + Players()\rank + "." + crlf)
PFound = #True
SaveFile(Players())
Break
EndIf
EndIf
Next
If PFound = #False
SelectElement(*Person\args(), 1)
SendNetworkString(*Person\CNum, "The player " + *Person\args() + " does not exist.")
EndIf
Else
SendNetworkString(*Person\CNum, "More functions will be added soon.")
EndIf
EndProcedure

Procedure Time(*Person.Person)
Protected dom.s = " " +Str(Day(Date())) + ", "
Protected mth.s
If Month(Date()) = 1
mth = " January "
ElseIf Month(Date()) = 2
mth = " February "
ElseIf Month(Date()) = 3
mth = " March "
ElseIf Month(Date()) = 4
mth = " April "
ElseIf Month(Date()) = 5
mth = " May "
ElseIf Month(Date()) = 6
mth = " June "
ElseIf Month(Date()) = 7
mth = " July "
ElseIf Month(Date()) = 8
mth = " August "
ElseIf Month(Date()) = 9
mth = " September "
ElseIf Month(Date()) = 10
mth = " October "
ElseIf Month(Date()) = 11
mth = " November "
Else
mth = " December "
EndIf
Protected dw.s
If DayOfWeek(Date()) = 0
dw = " Sunday, "
ElseIf DayOfWeek(Date()) = 1
dw = " Monday, "
ElseIf DayOfWeek(Date()) = 2
dw = " Tuesday, "
ElseIf DayOfWeek(Date()) = 3
dw = " Wednesday, "
ElseIf DayOfWeek(Date()) = 4
dw = " Thursday, "
ElseIf DayOfWeek(Date()) = 5
dw = " Friday, "
Else
dw = " Saturday, "
EndIf
Protected hr.s = Str(Hour(Date()))
If Hour(Date()) = 0
hr = "12"
EndIf
Protected mn.s = Str(Minute(Date()))
Protected dayhour.s
If Hour(Date()) >= 12
dayhour = "PM."
If Hour(Date()) > 12
hr = Str(Hour(Date()) -12)
EndIf
Else
dayhour = "AM."
EndIf
SendNetworkString(*Person\CNum, "Server time is: " + dw + mth + dom + Str(Year(Date())) + crlf + hr + ":" + mn + " " + dayhour + crlf)
EndProcedure

Procedure Tell(*Person.Person)
Protected x.i = 0
Protected kick.s = ""
Protected who.s = ""
For x = 1 To CountString(*Person\Text, " ") + 1
If x = 2
who = StringField(*Person\Text, x, " ")
ElseIf x > 2
kick = kick + StringField(*Person\Text, x, " ") + " "
EndIf
Next
If who = ""
SendNetworkString(*Person\CNum, "You must type <tell> <playername> <message>." + crlf)
ProcedureReturn
EndIf
If who = *Person\Name
SendNetworkString(*Person\CNum, "You can't tell yourself." + crlf)
ProcedureReturn
EndIf
Protected PList.i = 0
For PList = 0 To ListSize(Players()) -1
Delay(75)
SelectElement(Players(), PList)
If Players()\Name = who
SendNetworkString(*Person\CNum, "You tell " + Players()\Name + ", " + kick + crlf)
SendNetworkString(Players()\CNum, *Person\Name+ " tells you, " + kick + crlf)
Players()\LastTell = *Person\Name
ProcedureReturn
EndIf
Next
SendNetworkString(*Person\CNum, "This player does not exist." + crlf)
EndProcedure

Procedure Reply(*Person.Person)
Protected x.i = 0
Protected kick.s = ""
For x = 2 To CountString(*Person\Text, " ") + 1
kick = kick + StringField(*Person\Text, x, " ") + " "
Next
If kick = ""
SendNetworkString(*Person\CNum, "You must type <reply> <message>." + crlf)
ProcedureReturn
EndIf
Protected PList.i = 0
For PList = 0 To ListSize(Players()) -1
Delay(75)
SelectElement(Players(), PList)
If Players()\Name = *Person\LastTell
SendNetworkString(*Person\CNum, "You tell " + Players()\Name + ", " + kick + crlf)
SendNetworkString(Players()\CNum, *Person\Name+ " tells you, " + kick + crlf)
Players()\LastTell = *Person\Name
ProcedureReturn
EndIf
Next
SendNetworkString(*Person\CNum, "This player does not exist." + crlf)
EndProcedure

Procedure motd(*Person.Person)
Protected f.i
Protected RString.s
OpenFile(0, "motd.txt")
f = ReadFile(#PB_Any, "motd.txt")
SendNetworkString(*Person\CNum, "MOTD:" + crlf)
While Eof(f) = 0
RString = ReadString(f)
SendNetworkString(*Person\CNum, RString + crlf)
Wend
CloseFile(0)
EndProcedure

Procedure Register(*Person.Person)
ForEach Players()
Delay(75)
If Players() <> *Person And *Person\Name = Players()\Name
Players()\QFlag = #True
Break
EndIf
Next
Protected RString.s
Protected f.i
If *Person\Logged = #True
MsgAll(*Person\Name, *Person\Name + " has entered the game.")
*Person\ConTime = Date()
SendNetworkString(*Person\CNum, "Welcome To " + MudName + "! Type help For the List of commands. The current message of the day is:" + crlf)
PrintN(*Person\Name + " has just logged in.")
Speech(*Person\Name + " has just logged in.")
OpenFile(0, "motd.txt")
f = ReadFile(#PB_Any, "motd.txt")
While Eof(f) = 0
RString = ReadString(f)
SendNetworkString(*Person\CNum, RString + crlf)
Wend
CloseFile(0)
EndIf
Timer(*Person)
*Person\command = "game"
Time(*Person)
EndProcedure

Procedure.s StrGender(*Person.Person)
If *Person\Gender = 1
ProcedureReturn "male"
ElseIf *Person\Gender = 2
ProcedureReturn "female"
EndIf
EndProcedure

Procedure Gender(*Person.Person)
*Person\command = "gender"
SendNetworkString(*Person\CNum, "Please choose your gender." + crlf + "1 for male or 2 for female." + crlf)
While *Person\Text = ""
Delay(75)
Wend
If Val(*Person\Text) > 0 And Val(*Person\Text) < 3
*Person\Gender = Val(*Person\Text)
SendNetworkString(*Person\CNum, "You are now a " + StrGender(*Person) + "." + crlf)
*Person\Text = ""
*Person\rank = 1
*Person\health = 10000
*Person\strength = 3
*Person\vitality = 3
*Person\moves = 3
*Person\PFlag = #True
*Person\Logged = #True
Protected f.i
If OpenDatabase(f, "server.db", "", "") <> 0
SetDatabaseString(f, 0, *Person\Name)
SetDatabaseString(f, 1, *Person\Password)
SetDatabaseLong(f, 2, *Person\rank)
SetDatabaseLong(f, 3, *Person\Gender)
SetDatabaseLong(f, 4, *Person\health)
SetDatabaseLong(f, 5, *Person\strength)
SetDatabaseLong(f, 6, *Person\vitality)
SetDatabaseLong(f, 7, *Person\moves)
SetDatabaseLong(f, 8, *Person\PFlag)
SetDatabaseLong(f, 9, *Person\KeepAlive)
DatabaseUpdate(f, "INSERT INTO players (name, password, rank, gender, health, strength, vitality, moves, prompt, keepalive) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)")
SetDatabaseString(f, 0, *Person\Name)
DatabaseQuery(f, "SELECT id FROM players WHERE name = ?")
NextDatabaseRow(f)
*Person\id = GetDatabaseLong(f, DatabaseColumnIndex(f, "id"))
FinishDatabaseQuery(f)
CloseDatabase(f)
EndIf
Register(*Person)
Else
SendNetworkString(*Person\CNum, "You must choose either 1 for male or 2 for female." + crlf)
*Person\Text = ""
Gender(*Person)
EndIf
EndProcedure

Procedure Password(*Person.Person)
*Person\command = "password"
If *Person\Password <> ""
SendNetworkString(*Person\CNum, "Please type the existing password For " + *Person\Name + ".")
While *Person\Text = ""
Delay(75)
Wend
If *Person\Text <> *Person\Password
*Person\PassTries = *Person\PassTries +1
If *Person\PassTries = 3
SendNetworkString(*Person\CNum, "You have made too many attempts to connect to this account and will be kicked from the server." + crlf)
*Person\QFlag = #True
ProcedureReturn
EndIf
SendNetworkString(*Person\CNum, "The password you entered is incorrect." + crlf)
*Person\Text = ""
Password(*Person)
Else
*Person\Logged = #True
Register(*Person)
EndIf
*Person\Text = ""
Else
SendNetworkString(*Person\CNum, "Please type the new password For " + *Person\Name + ".")
While *Person\Text = ""
Delay(75)
Wend
*Person\Password = *Person\Text
*Person\Text = ""
SendNetworkString(*Person\CNum, "Now please retype your password.")
While *Person\Text = ""
Delay(75)
Wend
If *Person\Text <> *Person\Password
SendNetworkString(*Person\CNum, "Passwords do not match." + crlf)
*Person\Text = ""
*Person\Password = ""
Password(*Person)
Else
*Person\Text = ""
Gender(*Person)
EndIf
EndIf
EndProcedure

Procedure Name(*Person.Person)
SendNetworkString(*Person\CNum, "Please type your chosen name.")
While *Person\Text = ""
Delay(75)
Wend
Protected f.i
If OpenDatabase(f, "server.db", "", "") <> 0
SetDatabaseString(f, 0, *Person\Text)
DatabaseQuery(f, "SELECT * FROM players WHERE name = ?")
NextDatabaseRow(f)
*Person\id = GetDatabaseLong(f, DatabaseColumnIndex(f, "id"))
*Person\Name = GetDatabaseString(f, DatabaseColumnIndex(f, "name"))
*Person\rank = GetDatabaseLong(f, DatabaseColumnIndex(f, "rank"))
*Person\Gender = GetDatabaseLong(f, DatabaseColumnIndex(f, "gender"))
*Person\Password = GetDatabaseString(f, DatabaseColumnIndex(f, "password"))
*Person\health = GetDatabaseLong(f, DatabaseColumnIndex(f, "health"))
*Person\strength = GetDatabaseLong(f, DatabaseColumnIndex(f, "strength"))
*Person\vitality = GetDatabaseLong(f, DatabaseColumnIndex(f, "vitality"))
*Person\moves = GetDatabaseLong(f, DatabaseColumnIndex(f, "moves"))
*Person\PFlag = GetDatabaseLong(f, DatabaseColumnIndex(f, "prompt"))
*Person\KeepAlive = GetDatabaseLong(f, DatabaseColumnIndex(f, "keepalive"))
FinishDatabaseQuery(f)
CloseDatabase(f)
If *Person\Name <> ""
*Person\Text = ""
SendNetworkString(*Person\CNum, "The character " + *Person\Name + " already exists." + crlf)
Password(*Person)
ProcedureReturn
EndIf
*Person\Name = *Person\Text
*Person\Text = ""
SendNetworkString(*Person\CNum, "Welcome to " + MudName + ", " + *Person\Name + "." + crlf)
Password(*Person)
EndIf
*Person\Text = ""
EndProcedure

Procedure Boot(*Person.Person)
Protected x.i = 0
Protected kick.s = ""
Protected who.s = ""
For x = 1 To CountString(*Person\Text, " ") + 1
If x = 2
who = StringField(*Person\Text, x, " ")
ElseIf x > 2
kick = kick + StringField(*Person\Text, x, " ") + " "
EndIf
Next
If who = ""
SendNetworkString(*Person\CNum, "You must type <boot> <playername> <reason> optional." + crlf)
ProcedureReturn
EndIf
ForEach Players()
Delay(75)
If Players()\Name = who And *Person\rank >= Players()\rank
SendNetworkString(*Person\CNum, Players()\Name + " has been kicked." + crlf)
SendNetworkString(Players()\CNum, "You have been kicked by " + *Person\Name + " for the following reason: " + kick + crlf)
Players()\QFlag = #True
ProcedureReturn
ElseIf *Person\rank < Players()\rank
SendNetworkString(*Person\CNum, "You do not have the authority to boot " + who + " from the server." + crlf)
ProcedureReturn
EndIf
Next
SendNetworkString(*Person\CNum, "This player does not exist." + crlf)
EndProcedure


Procedure RFile(*Person.person)
Protected RString.s
Protected f.i
If FileSize("players\" + *Person\Name + ".plr") > -1
f = ReadFile(#PB_Any, "players/" + *Person\Name+".plr")
SendNetworkString(*Person\CNum, "Here is the file in its entirety." + crlf)
While Eof(f) = 0
RString = ReadString(f)
SendNetworkString(*Person\CNum, RString + crlf)
Wend
CloseFile(f)
Else
SendNetworkString(*Person\CNum, "Your data file does not exist yet. Please type save.")
EndIf
EndProcedure

Procedure Who(*Person.Person)
Protected c = 0
Protected people.s = ""
ForEach Players()
Delay(75)
If Players()\Logged= #True
c = c + 1
EndIf
Next
SendNetworkString(*Person\CNum, "There are " + c + " players who are online:" + crlf)
ForEach Players()
Delay(75)
If Players()\Logged = #True
people = people + Players()\Name + crlf + #LF$
EndIf
Next
SendNetworkString(*Person\CNum, people + crlf + #LF$)
*Person\Text = ""
EndProcedure

Procedure Quit(*Person.Person)
SaveFile(*Person)
SendNetworkString(*Person\CNum, "Goodbye " + *Person\Name + ". Thanks For checking out " + MudName + "." + crlf)
*Person\QFlag = #True
EndProcedure

Procedure help(*Person.Person)
SendNetworkString(*Person\CNum, "The game is still being developed so test functions are a must." + crlf)
SendNetworkString(*Person\CNum, "Type info to get information about the game,"+ crlf)
SendNetworkString(*Person\CNum, "stats to see info about you," + crlf)
SendNetworkString(*Person\CNum, "who to find out how many people are online," + crlf)
SendNetworkString(*Person\CNum, "shutdown To completely shut down the server,"+ crlf)
SendNetworkString(*Person\CNum, "quit to close the connection and delete your player info,"+ crlf)
SendNetworkString(*Person\CNum, "or help for this help information."+ crlf)
EndProcedure

Procedure say(*Person.Person)
Protected SayMsg.s
SendNetworkString(*Person\CNum, "You say: " + Right(*Person\Text, Len(*Person\Text) -4) + crlf)
SayMsg = Right(*Person\Text, Len(*Person\Text) -4)
ForEach Players()
Delay(75)
If Players()\Name = *Person\Name Or Players()\Logged = #False
Continue
EndIf
SendNetworkString(Players()\CNum, *Person\Name + " says: " + SayMsg + crlf)
Next
EndProcedure

Procedure shutdown(*Person.Person)
Protected SayMsg.s
SayMsg = Right(*Person\Text, Len(*Person\Text) -9)
ForEach Players()
Delay(75)
SendNetworkString(Players()\CNum, "Server shutdown initiated by " + *Person\Name + " for the following reason: " + SayMsg + crlf)
Quit(Players())
Next
*Person\PFlag = #False
EndProcedure

Procedure info(*Person.Person)
SendNetworkString(*Person\CNum, "Dark ages written by Justin Miller." + crlf)
SendNetworkString(*Person\CNum, "copyright 2023 by Justin Miller." + crlf)
EndProcedure

IncludeFile "commands.pb"

Procedure NetworkConnectEvent(cnt.i)
Protected *Person.Person
SetEnvironmentVariable("SText", "A client just connected with the ip " + IPString(GetClientIP(cnt)))

If MaxPlayers = ListSize(Players())
SendNetworkString(cnt, "Max clients are reached!" + crlf)
CloseNetworkConnection(cnt)
cnt = 0
LockMutex(mutex)
PrintN("Max clients are reached!")
Speech("Max clients are reached.")
UnlockMutex(mutex)
Else
ForEach Players()
Delay(75)
If Players()\CNum = cnt
*Person = Players()
EndIf
Next
If *Person = #Null
*Person = AddElement(Players())

*Person\CNum = cnt
*Person\LastData = Date()
*Person\command = "registering"
EndIf
Delay(1000)
SendNetworkString(cnt, "Welcome to " + MudName + ". " + crlf + "This game is under development." + crlf)
PrintN("A client has connected with the ip " + IPString(GetClientIP(cnt)) + ".")
Speech("A client has connected with the ip " + IPString(GetClientIP(cnt)) + ".")
PlaySound(0)

If Name(*Person)
EndIf
EndIf
EndProcedure

Procedure NetworkDataEvent(cnt.i)
Protected.i received
Protected *data
Protected *Person.Person
ForEach Players()
Delay(75)
If Players()\CNum = cnt
*Person = Players()
EndIf
Next
If *Person = #Null
*Person = AddElement(Players())
*Person\CNum = cnt
EndIf
*Person\LastData = Date()
*data = AllocateMemory(4096, #PB_Memory_NoClear)
If *data
received = ReceiveNetworkData(cnt, *data, MemorySize(*Data))
If received > 0
*Person\Text = PeekS(*data, received, #PB_UTF8|#PB_ByteLength)
*Person\Text = Left(*Person\Text, Len(*Person\Text) - 2)
If *Person\command = "game"
Protected cmd.s = StringField(*Person\Text, 1, " ")
Protected x = 2
;---Protected NewList args.s()
Split(*Person\Text,*Person\args())
SelectElement(*Person\args(), 0)
DeleteElement(*Person\args())
command(LCase(cmd), *Person\args(), *Person)
*Person\Text = ""
EndIf
If *Person\Logged And *Person\PFlag
SendNetworkString(*Person\CNum, Str(*Person\health) + "health, " + Str(*Person\strength) + "strength, " + Str(*Person\vitality) + "vitality, " + Str(*Person\moves) + "moves")
EndIf
FreeMemory(*data)
EndIf
EndIf
EndProcedure

Procedure Main()
OpenConsole("Server setup")
Delay(100)
OpenFile(0, "motd.txt")
CloseFile(0)
If FileSize("settings.conf") = -1
CreateFile(0, "settings.conf")
PrintN("What's the maximum number of players allowed to connect to the server?")
Speech("What's the maximum amount of players allowed to connected to the server?")
MaxPlayers = Val(Input())
If MaxPlayers < 1
PrintN("Default: The Default maximum players allowed is 3.")
Speech("Default: The default maximum players will be set to 3")
MaxPlayers = 3
EndIf
PrintN("Please enter a name for your game.")
Speech("Please enter a name for your game.")
MudName = Input()
ConsoleTitle(MudName)
PrintN("Please enter a port number For incomming connections.")
Speech("Please enter a port number for the server to accept incoming connections.")
port = Val(Input())
If port = 0
PrintN("Port must have a value. Since nothing was entered the port will be set To 4000 As the Default.")
Speech("Port must have a value. Since nothing was entered the port number will be set to 4000.")
port = 4000
EndIf
WriteStringN(0, Str(MaxPlayers))
WriteStringN(0, MudName)
WriteStringN(0, Str(port))
CloseFile(0)
PrintN("The server configuration settings have been saved To settings.conf.")
Speech("The server configuration settings have been saved to settings.conf")
Else
OpenFile(0, "settings.conf")
MaxPlayers = Val(ReadString(0))
PrintN("Max players is set to: " + Str(MaxPlayers))
MudName = ReadString(0)
ConsoleTitle(MudName)
PrintN("Mud name is set to: " + MudName)
port = Val(ReadString(0))
PrintN("Port is set to: " + Str(port))
CloseFile(0)
EndIf
If CreateNetworkServer(0, port, #PB_Network_TCP, "0.0.0.0") = 0
PrintN("Error: The server could Not be started.")
Speech("Error: The server could not be started.")
End
EndIf
SrvTime = Date()
PrintN("Server started successfully.")
Speech("Server started successfully.")
mutex = CreateMutex()
Repeat

Inkey()
If RawKey() = 27
PrintN("Exit: The server will now close.")
Speech("Exit: The server will now close.")
ForEach Players()
Delay(75)
SendNetworkString(Players()\CNum, "The server is shutting down.")
Quit(Players())
Next
Exit = #True
EndIf

Select NetworkServerEvent(0)
Case #PB_NetworkEvent_Connect
CreateThread(@NetworkConnectEvent(), EventClient())

Case #PB_NetworkEvent_Data
CreateThread(@NetworkDataEvent(), EventClient())

Case #PB_NetworkEvent_Disconnect
Protected y.i = 0
For y = 0 To ListSize(Players()) -1
Delay(75)
SelectElement(Players(), y)
If EventClient() = Players()\CNum
If Players()\Logged
Speech(Players()\Name + " has terminated the connection.")
EndIf
DeleteElement(Players())
If ListSize(Players()) = 0
ClearList(Players())
EndIf
Break
EndIf
Next

Case #PB_NetworkEvent_None
Protected x.i = ListSize(Players())
Delay(75)
For x = ListSize(Players()) -1 To 0 Step -1
Delay(75)
SelectElement(Players(), x)
If Players()\KeepAlive
Players()\LastData = Date()
EndIf
If Date() = Players()\ElTime
SendNetworkString(Players()\CNum, Chr(9))
Timer(Players())
EndIf
If (Players()\QFlag = #True) Or (Players()\LastData < Date() - 180 And Players()\KeepAlive = #False)
If Players()\QFlag
MsgAll(Players()\Name, Players()\Name + " has left the game.")
SelectElement(Players(), x)
PrintN("Info: " + Players()\Name + " has chosen to disconnect.")
Speech("Info: " + Players()\Name + " has chosen to disconnect.")
Else
If Players()\Logged = #False
PrintN("Info: Client " + Str(Players()\CNum) + " disconnected due to inactivity.")
Speech("Info: Client " + Str(Players()\CNum) + " disconnected due to inactivity.")
Else
PrintN(Players()\Name + " has been disconnected do to inactivity.")
Speech(Players()\Name + " has been disconnected do to inactivity.")
SendNetworkString(Players()\CNum, "You have been disconnected because you were idle for 3 minutes.")
EndIf
EndIf
CloseNetworkConnection(Players()\CNum)
DeleteElement(Players())
If ListSize(Players()) = 0
ClearList(Players())
EndIf
EndIf
Next
EndSelect
Until Exit
CloseNetworkServer(0)
EndProcedure

Main()

[mk-soft]

Please use Code-Tags.

I haven't looked at the code closely, but:

1.
Data is transferred per client, but not separated according to SendNetworkData. You have to separate the receive data yourself.
SendNetworkData transfers the data for sending to the send buffer. ReceiveNetworkData fetches the data accumulated up to that point from the receive buffer. This can be a part of the data or already a part of the next data
2.
A thread for the server.
3.
Call ReceiveNetworkData in server thread. Not in an extra thread. When the data is complete, you can pass it to a thread.

The TCP/IP protocol ensures that the connection is established and that the data up to 64kb arrive in the correct order.
Each client has its own receive buffer and send buffer. However, it does not ensure that the data is complete or that the data is separated. You have to programme this level yourself. For example with separators for pure text or with header data where the length is included.

See Module NetworkTCP

[justin.miller423]

Hello Spiky,
Hopefully your able to help. I made a zip file what what me and my friend tried to do. He doesn't want anything to do with Pure Basic but I want to keep working on this project if I could get help with my thread problem. For example now when I try to create a new character and get to the password part it crashes. I handled the network disconnect event thing but it still acts funny with threads. For instance if you try to say something and another client is connected.
Any way, I don't expect for anyone to write my code for me but if I could at least get the thread problem handled I should be good. Here is the link to my complete code. Keep in mind that Justin is the server administrator so you'd need to access the database to log in or use the escape key from within the server itself to shut it down for now.
If you come up with anything my teamtalk info is below if at all possible for you to try out.
blindbastards.com
username: guest
password: guest
Code is here.
http://www.blindbastards.com/DarkAges.zip

Ok, I can see one potential crash on line 649. You aren't handling #PB_NetworkEvent_Disconnect and you need to. The underlying connection is invalidated by the event and if you subsequently try to access it an IMA will occur. In this case your idle timeout subsequently attempts to close a non-existent connection and crashes.

Clear the Players()\CNum value immediately on receiving #PB_NetworkEvent_Disconnect, and check for a zero CNum before closing in the idle timeout section. (For robustness when scaling to lots of clients, you may need to make a similar check on zero CNum before 'Sending' too).

I changed 649 to look like:

Code: Select all

If Players()\CNum > 0
  CloseNetworkConnection(Players()\CNum)
EndIf

And I added this to the 'Select/Case' at 617:

Code: Select all

Case #PB_NetworkEvent_Disconnect
  NetworkDisconnectEvent(EventClient())

And a new procedure, like this:

Code: Select all

Procedure NetworkDisconnectEvent(cnt.i)
  
  Protected *Person.Person
  
  ForEach Players()
    If Players()\CNum = cnt
      *Person = Players()
      *Person\QFlag = #True
      *Person\CNum = 0
    EndIf
  Next Players()
  
EndProcedure

You can upload any files you change to there please.
Thanks in advance.

[justin.miller423]

I forgot to mention the teamtalk port number in case someone can help.
The port number is 10333. And sorry if I didn't post this right. These post replies are confusing to me when it comes to where I should put my reply because the forum adds extra stuff. Being blind with the way this forum is I'm doing my best so I'll just say sorry ahead of time in case.
Thanks for reading.

Hello,
I was wondering if someone could help me fix a small issue. This mud server or telnet server if you will doesn't keep the connections alive after a while.
I was wondering if someone could help fix either a memory leak or some other problem I'm overlooking.
I'm not good with memory access stuff yet but the program seems to hold on for around 13 hours since I got it to send an "'" string but when the last connection is lost it crashes the server completely and I think it has something to do with the list but even running locally there's a problem this is why I figured it was a memory issue.
Here is the complete code.

Code: Select all

EnableExplicit


Structure Person
  Name.s
  rank.i
  Gender.i
  Password.s
  PassTries.i
  Email.s
  health.i
  strength.i
  vitality.i
  moves.i
  CNum.i
  LastData.i
  ElTime.i
  PFlag.b
  Text.s
  command.s
  LastTell.s
  KeepAlive.b
  QFlag.b
  Logged.b
EndStructure

Global NewList Players.Person()
Global MudName.s
Global MaxPlayers.i
Global port.i
Global Exit.b


Procedure MsgAll(name.s, msg.s, logged.b = #True)
  ForEach Players()
    If logged
      If name <> Players()\Name And Players()\Logged
      SendNetworkString(Players()\CNum, msg + #CR$)
    EndIf
    Else
      If name <> Players()\Name
      SendNetworkString(Players()\CNum, msg + #CR$)
    EndIf
  EndIf
  Next
EndProcedure
Procedure Timer(*Person.Person)
*Person\ElTime = AddDate(Date(), #PB_Date_Minute, 1)  
  
EndProcedure

Procedure Test(*Person.Person)
  SendNetworkString(*Person\CNum, "Current directory is: " + GetCurrentDirectory())
EndProcedure

Procedure Time(*Person.Person)
  Protected dom.s = " " +Str(Day(Date())) + ", "
  Protected mth.s
  If Month(Date()) = 1
    mth = " January "
  ElseIf Month(Date()) = 2
    mth = " February "
  ElseIf Month(Date()) = 3
    mth = " March "
  ElseIf Month(Date()) = 4
    mth = " April "
  ElseIf Month(Date()) = 5
    mth = " May "
  ElseIf Month(Date()) = 6
    mth = " June "
  ElseIf Month(Date()) = 7
    mth = " July "
  ElseIf Month(Date()) = 8
    mth = " August "
  ElseIf Month(Date()) = 9
    mth = " September "
  ElseIf Month(Date()) = 10
    mth = " October "
  ElseIf Month(Date()) = 11
    mth = " November "
  Else
    mth = " December "
  EndIf
  Protected dw.s
  If DayOfWeek(Date()) = 0
    dw = " Sunday, "
  ElseIf DayOfWeek(Date()) = 1
    dw = " Monday, "
  ElseIf DayOfWeek(Date()) = 2
    dw = " Tuesday, "
  ElseIf DayOfWeek(Date()) = 3
    dw = " Wednesday, "
  ElseIf DayOfWeek(Date()) = 4
    dw = " Thursday, "
  ElseIf DayOfWeek(Date()) = 5
    dw = " Friday, "
  Else
    dw = " Saturday, "
  EndIf
  Protected hr.s = Str(Hour(Date()))
  If Hour(Date()) = 0
    hr = "12"
  EndIf
  Protected mn.s = Str(Minute(Date()))
  Protected dayhour.s
  If Hour(Date()) >= 12
    dayhour = "PM."
    If Hour(Date()) > 12
      hr = Str(Hour(Date()) -12)
    EndIf
  Else
    dayhour = "aAM."
  EndIf
  SendNetworkString(*Person\CNum, "The current server time is: " + dw + mth + dom + Str(Year(Date())) + #CR$ + hr + ":" + mn + " " + dayhour + #CR$)
EndProcedure

Procedure Tell(*Person.Person)
  Protected x.i = 0
  Protected kick.s = ""
  Protected who.s = ""
  For x = 1 To CountString(*Person\Text, " ") + 1
    If x = 2
      who = StringField(*Person\Text, x, " ")
    ElseIf x > 2
      kick = kick + StringField(*Person\Text, x, " ") + " "
    EndIf
  Next
  If who = ""
    SendNetworkString(*Person\CNum, "You must type <tell> <playername> <message>." + #CR$)
    ProcedureReturn
  EndIf
  If who = *Person\Name
    SendNetworkString(*Person\CNum, "You can't tell yourself." + #CR$)
    ProcedureReturn
  EndIf
  ForEach Players()
    If Players()\Name = who
      SendNetworkString(*Person\CNum, "You tell " + Players()\Name + ", " + kick + #CR$)
      SendNetworkString(Players()\CNum, *Person\Name+ " tells you, " + kick + #CR$)
      Players()\LastTell = *Person\Name
      ProcedureReturn
    EndIf
    Next
    SendNetworkString(*Person\CNum, "This player does not exist." + #CR$)
EndProcedure

Procedure Reply(*Person.Person)
  Protected x.i = 0
  Protected kick.s = ""
  For x = 2 To CountString(*Person\Text, " ") + 1
    kick = kick + StringField(*Person\Text, x, " ") + " "
  Next
  If kick = ""
    SendNetworkString(*Person\CNum, "You must type <reply> <message>." + #CR$)
    ProcedureReturn
  EndIf
  ForEach Players()
    If Players()\Name = *Person\LastTell
      SendNetworkString(*Person\CNum, "You tell " + Players()\Name + ", " + kick + #CR$)
      SendNetworkString(Players()\CNum, *Person\Name+ " tells you, " + kick + #CR$)
      Players()\LastTell = *Person\Name
      ProcedureReturn
    EndIf
  Next
  SendNetworkString(*Person\CNum, "This player does not exist." + #CR$)
EndProcedure

Procedure motd(*Person.Person)
  Protected f.i
  Protected RString.s
  OpenFile(0, "motd.txt")
    f = ReadFile(#PB_Any, "motd.txt")
    SendNetworkString(*Person\CNum, "MOTD:" + #CR$)
    While Eof(f) = 0
      RString = ReadString(f)
      SendNetworkString(*Person\CNum,  RString + #CR$)
    Wend
  CloseFile(0)
EndProcedure

Procedure Register(*Person.Person)
  ForEach Players()
    If Players() <> *Person And *Person\Name = Players()\Name
      Players()\QFlag = #True
      Break
    EndIf
  Next
  Protected RString.s
  Protected f.i
    If *Person\Logged = #True
      MsgAll(*Person\Name, *Person\Name + " has entered the game.")
      SendNetworkString(*Person\CNum, "Welcome To " + MudName + "! Type help For the List of commands. The current message of the day is:" + #CR$)
      PrintN(*Person\Name + " has just logged in.")
      OpenFile(0, "motd.txt")
        f = ReadFile(#PB_Any, "motd.txt")
        While Eof(f) = 0
          RString = ReadString(f)
          SendNetworkString(*Person\CNum,  RString + #CR$)
        Wend
      CloseFile(0)
    EndIf
    *Person\PFlag = #True
    Timer(*Person)
    *Person\command = "game"
  Time(*Person)
EndProcedure

Procedure.s StrGender(*Person.Person)
  If *Person\Gender = 1
    ProcedureReturn "male"
  ElseIf *Person\Gender = 2
    ProcedureReturn "female"
  EndIf
EndProcedure

Procedure Gender(*Person.Person)
  If *Person\Text = ""
    SendNetworkString(*Person\CNum, "Please choose your gender." + #CR$ + "1 for male or 2 for female." + #CR$)
    ProcedureReturn
  EndIf
  If Val(*Person\Text) > 0 And Val(*Person\Text) < 3
    *Person\Gender = Val(*Person\Text)
    SendNetworkString(*Person\CNum, "You are now a " + StrGender(*Person) + "." + #CR$)
    *Person\rank = 1
    *Person\health = 10000
    *Person\strength = 3
    *Person\vitality = 3
    *Person\moves = 3
    *Person\Logged = #True
    Register(*Person)
  Else
    SendNetworkString(*Person\CNum, "You must choose either 1 for male or 2 for female." + #CR$)
  EndIf
EndProcedure

Procedure Name(*Person.Person)
  If *Person\Text = ""
    SendNetworkString(*Person\CNum, "Please type your chosen name.")
    ProcedureReturn
  EndIf
  Protected f.i
  Protected RString.s
  If FileSize("players\"+*Person\Text+".plr") > -1
    f = ReadFile(#PB_Any, "players/" + *Person\Text+".plr")
      RString = ReadString(f)
      *Person\Name = RString
      RString = ReadString(f)
      *Person\rank = Val(RString)
      RString = ReadString(f)
      *Person\Password = RString
      RString = ReadString(f)
      *Person\Gender = Val(RString)
      RString = ReadString(f)
      *Person\health = Val(RString)
      RString = ReadString(f)
      *Person\strength = Val(RString)
      RString = ReadString(f)
      *Person\vitality = Val(RString)
      RString = ReadString(f)
      *Person\moves = Val(RString)
      SendNetworkString(*Person\CNum, "The character " + *Person\Text + " already exists." + #CR$)
    CloseFile(f)
  Else
    *Person\Name = *Person\Text
    SendNetworkString(*Person\CNum, "Welcome, " + *Person\Name + "." + #CR$)
  EndIf
  *Person\command = "password"
  If *Person\Password <> ""
    SendNetworkString(*Person\CNum, "Please type the existing password For " + *Person\Name + ".")
  Else
    SendNetworkString(*Person\CNum, "Please type the new password For " + *Person\Name + ".")
  EndIf
EndProcedure

Procedure Boot(*Person.Person)
  Protected x.i = 0
  Protected kick.s = ""
  Protected who.s = ""
  For x = 1 To CountString(*Person\Text, " ") + 1
    If x = 2
      who = StringField(*Person\Text, x, " ")
    ElseIf x > 2
      kick = kick + StringField(*Person\Text, x, " ") + " "
    EndIf
  Next
  If who = ""
    SendNetworkString(*Person\CNum, "You must type <boot> <playername> <reason> optional." + #CR$)
    ProcedureReturn
  EndIf
  ForEach Players()
    If Players()\Name = who And *Person\rank >= Players()\rank
      SendNetworkString(*Person\CNum, Players()\Name + " has been kicked." + #CR$)
      SendNetworkString(Players()\CNum, "You have been kicked by " + *Person\Name + " for the following reason: " + kick + #CR$)
      Players()\QFlag = #True
      ProcedureReturn
    ElseIf *Person\rank < Players()\rank
      SendNetworkString(*Person\CNum, "You do not have the authority to boot " + who + " from the server." + #CR$)
      ProcedureReturn
    EndIf
  Next
  SendNetworkString(*Person\CNum, "This player does not exist." + #CR$)
EndProcedure
  
Procedure Password(*Person.Person)
  If *Person\command = "password" And *Person\Password <> ""
    If *Person\Text = ""
      SendNetworkString(*Person\CNum, "Please type the existing password For " + *Person\Name + ".")
      ProcedureReturn
    EndIf
    If *Person\Text <> *Person\Password
      *Person\PassTries = *Person\PassTries +1
      If *Person\PassTries  = 3        
        SendNetworkString(*Person\CNum, "You have made too many attempts to connect to this account and will be kicked from the server." + #CR$)
        *Person\QFlag = #True
        ProcedureReturn
      EndIf
      SendNetworkString(*Person\CNum, "The password you entered is incorrect." + #CR$ + "Please retype the password.")
    Else
      *Person\Logged = #True
      Register(*Person)
    EndIf
  ElseIf *Person\command = "password" And *Person\Password = ""
    If *Person\Text = ""
      SendNetworkString(*Person\CNum, "Please type the new password For " + *Person\Name + ".")
      ProcedureReturn
    EndIf
    *Person\Password = *Person\Text
    *person\command = "repassword"
    SendNetworkString(*Person\CNum, "Now please retype your password.")
    ElseIf *Person\command = "repassword" And *Person\Password <> ""
    If *Person\Text = ""
      SendNetworkString(*Person\CNum, "Now please retype your password.")
      ProcedureReturn
    EndIf
    If *Person\Text <> *Person\Password
      SendNetworkString(*Person\CNum, "Passwords do not match." + #CR$ + "Please retype your password.")
      *Person\Password = ""
      *Person\command = "password"
    Else
      *person\command = "gender"
      SendNetworkString(*Person\CNum, "Please choose your gender." + #CR$ + "1 for male or 2 for female." + #CR$)
    EndIf
  EndIf
EndProcedure

Procedure SaveFile(*Person.Person)
  Protected f.i
  CreateFile(f, "players/" + *Person\Name+".plr")
  WriteStringN(f, *Person\Name + #CR$ + *Person\rank + #CR$ + *Person\Password + #CR$ + Str(*Person\Gender) + #CR$ + Str(*Person\health) + #CR$ + Str(*Person\strength) + #CR$ + Str(*Person\vitality) + #CR$ + Str(*Person\moves))
  CloseFile(f)
EndProcedure

Procedure RFile(*Person.person)
  Protected RString.s
  Protected f.i
  If FileSize("players\" + *Person\Name + ".plr") > -1
    f = ReadFile(#PB_Any, "players/" + *Person\Name+".plr")
      SendNetworkString(*Person\CNum,  "Here is the file in its entirety." + #CR$)
      While Eof(f) = 0
        RString = ReadString(f)
        SendNetworkString(*Person\CNum,  RString + #CR$)
      Wend
    CloseFile(f)
  Else
    SendNetworkString(*Person\CNum, "Your data file does not exist yet. Please type save.")
  EndIf
EndProcedure

Procedure Who(*Person.Person)
  Protected c = 0
  Protected people.s = ""
  ForEach Players()
    If Players()\Logged= #True
      c = c + 1
    EndIf
  Next
  SendNetworkString(*Person\CNum, "There are " + c + " players who are online:" + #CR$)
  ForEach Players()
    If Players()\Logged = #True
      people = people + Players()\Name + #CR$
    EndIf
  Next
  SendNetworkString(*Person\CNum, people + #CR$)
  *Person\Text = ""
EndProcedure

Procedure Quit(*Person.Person)
  SendNetworkString(*Person\CNum, "Goodbye " + *Person\Name + ". Thanks For checking out " + MudName + "." + #CR$)
  *Person\QFlag = #True
  Delay(10)
EndProcedure

Procedure help(*Person.Person)
  SendNetworkString(*Person\CNum, "The game is still being developed so test functions are a must." + #CR$)
  SendNetworkString(*Person\CNum, "Type info to get information about the game,"+ #CR$)
  SendNetworkString(*Person\CNum, "stats to see info about you," + #CR$)
  SendNetworkString(*Person\CNum, "who to find out how many people are online," + #CR$)
  SendNetworkString(*Person\CNum, "shutdown To completely shut down the server,"+ #CR$)
  SendNetworkString(*Person\CNum, "quit to close the connection and delete your player info,"+ #CR$)
  SendNetworkString(*Person\CNum, "or help for this help information."+ #CR$)
EndProcedure

Procedure say(*Person.Person)
  Protected SayMsg.s
  SendNetworkString(*Person\CNum, "You say: " + Right(*Person\Text, Len(*Person\Text) -4) + #CR$)
  SayMsg = Right(*Person\Text, Len(*Person\Text) -4)
  ForEach Players()
    If Players()\Name = *Person\Name Or Players()\Logged = #False
      Continue
    EndIf
    SendNetworkString(Players()\CNum, *Person\Name + " says: " + SayMsg + #CR$)
  Next
EndProcedure

Procedure shutdown(*Person.Person)
  Protected SayMsg.s
  SayMsg = Right(*Person\Text, Len(*Person\Text) -9)
  ForEach Players()
    SendNetworkString(Players()\CNum, "Server shutdown initiated by " + *Person\Name + " for the following reason: " + SayMsg + #CR$)
    Quit(Players())
  Next
EndProcedure

Procedure info(*Person.Person)
  SendNetworkString(*Person\CNum, "Dark ages written by Justin Miller." + #CR$)
  SendNetworkString(*Person\CNum, "copyright 2018 by Justin Miller." + #CR$)
  *Person\Text = ""
EndProcedure

Procedure NetworkConnectEvent(cnt.i) 
  Protected *Person.Person
 
  If MaxPlayers = ListSize(Players())
    SendNetworkString(cnt, "Max clients are reached!")
    Print("Max clients are reached!")
  Else
    ForEach Players()
      If Players()\CNum = cnt
        *Person = Players()
      EndIf
    Next
    If *Person = #Null
      *Person = AddElement(Players())
      
      *Person\CNum = cnt
      *Person\LastData = Date()
      *Person\command = "registering"
    EndIf
    Delay(500)
    SendNetworkString(cnt, "Welcome to " + MudName + ". " + #CR$ + "This game is under development." + #CR$)
    PrintN("A client has connected with the ip " + IPString(GetClientIP(cnt)) + ".")
    If *person\Name = ""
      Name(*Person)
    EndIf
  EndIf
EndProcedure

Procedure NetworkDataEvent(cnt.i) 
  Protected.i received
  Protected *data
  Protected *Person.Person
  ForEach Players()
    If Players()\CNum = cnt
      *Person = Players()
    EndIf
  Next
  If *Person = #Null
    *Person = AddElement(Players())
    *Person\CNum = cnt
  EndIf
  *Person\LastData = Date()
  *data = AllocateMemory(4096, #PB_Memory_NoClear)
  If *data
    received = ReceiveNetworkData(cnt, *data, MemorySize(*Data))
    If received > 0
      *Person\Text = PeekS(*data, received, #PB_UTF8|#PB_ByteLength)
      *Person\Text = Left(*Person\Text, Len(*Person\Text) - 2)
      If *Person\command = "game"
        Protected cmd.s = StringField(*Person\Text, 1, " ")
        *Person\Text = ReplaceString(*Person\Text, cmd, LCase(cmd))
        If Left(*Person\Text, 3) = "say"
          say(*Person)
        ElseIf *Person\Text = "test"
          Test(*Person)
        ElseIf *Person\Text = "prompt"
          If *Person\PFlag = #False
            *Person\PFlag = #True
            SendNetworkString(*Person\CNum, "Your prompt has been turned on." + #CR$)
          ElseIf *Person\PFlag
            *Person\PFlag = #False
          SendNetworkString(*Person\CNum, "Your prompt has been turned off." + #CR$)
        EndIf
      ElseIf Left(*Person\Text, 4) = "time"
          Time(*Person)
        ElseIf Left(*Person\Text, 8) = "announce"
          MsgAll(*Person\Name, *Person\Name + " has made an announcement." + #CR$ + Right(*Person\Text, Len(*Person\Text) -9), #True)
          SendNetworkString(*Person\CNum, "Your announcement was sent.")
        ElseIf Left(*Person\Text, 4) = "tell"
          Tell(*Person)
        ElseIf Left(*Person\Text, 5) = "reply"
          Reply(*Person)
        ElseIf Left(*Person\Text, 4) = "boot"
          If *Person\rank < 3
            SendNetworkString(*Person\CNum, "You do not have permission to use this command.")
            ProcedureReturn
          EndIf
          Boot(*Person)
        ElseIf *Person\Text = "motd"
          motd(*Person)
        ElseIf *Person\Text = "save"
          SaveFile(*Person)
          SendNetworkString(*Person\CNum, "Your player info has been saved.")
        ElseIf *Person\Text = "keepalive"
          If *Person\KeepAlive = 0
            *Person\KeepAlive = 1
            SendNetworkString(*Person\CNum, "Your keep alive flag is now on and you will not be disconnected from the server." + #CR$)
          ElseIf *Person\KeepAlive = 1
            *Person\KeepAlive = 0
            SendNetworkString(*Person\CNum, "Your keep alive flag has been turned off. After 3 minutes of inactivity you will be disconnected." + #CR$)
            *Person\LastData = Date()
          EndIf
        ElseIf *Person\Text = "rf"
          RFile(*Person)
        ElseIf *Person\Text = "stats"
          SendNetworkString(*Person\CNum, "You are " + *Person\Name + " rank " + *Person\rank + #CR$)
          SendNetworkString(*Person\CNum, " You are " + StrGender(*Person) + #CR$)
          SendNetworkString(*Person\CNum, " You have " + *Person\health + " health, " + #CR$ + *Person\strength + " strength, " + *Person\vitality + " vitality, and " + *Person\moves + " moves." + #CR$)
        ElseIf *Person\Text = "who"
          Who(*Person)
        ElseIf Left(*Person\Text, 8) = "shutdown"
          If *Person\rank < 5
            SendNetworkString(*Person\CNum, "You may not use this command because you are not the server administrator.")
            ProcedureReturn
          EndIf
          *Person\command = "shutdown"
          shutdown(*Person)
          Exit = #True
        ElseIf *Person\Text = "info"
          info(*Person)
        ElseIf *Person\Text = "quit"
          Quit(*Person)
        ElseIf *Person\Text = "help"
          help(*Person)
        Else
          SendNetworkString(*Person\CNum, "Huh?" + #CR$)
        EndIf
      ElseIf *Person\command = "registering"
        Name(*Person)
      ElseIf *Person\command = "password"
        Password(*Person)
      ElseIf *Person\command = "repassword"
        Password(*Person)
      ElseIf *Person\command = "gender"
        Gender(*Person)
      EndIf
      If Players()\Logged And Players()\PFlag
        SendNetworkString(*Person\CNum, Str(*Person\health) + "health, " + Str(*Person\strength) + "strength, " + Str(*Person\vitality) + "vitality, " + Str(*Person\moves) + "moves")
      EndIf
      *Person\Text = ""
      FreeMemory(*data)
    EndIf
  EndIf
EndProcedure

Procedure Main()
  OpenConsole("Server setup")
  Delay(100)
  OpenFile(0, "motd.txt")
  CloseFile(0)
  If FileSize("settings.conf") = -1
    CreateFile(0, "settings.conf")
      Print ("What's the maximum number of players allowed to connect to the server?")
      MaxPlayers = Val(Input())
      If MaxPlayers < 1
        PrintN("Default: The Default maximum players allowed is 3.")
        MaxPlayers = 3
      EndIf
      Print ("Please enter a name for your game.")
      MudName = Input()
      ConsoleTitle(MudName)
      Print ("Please enter a port number for incomming connections.")
      port = Val(Input())
      If port = 0
        PrintN("Port must have a value. Since nothing was entered the port will be set to 4000 as the default.")
        port = 4000
      EndIf
      WriteStringN(0, Str(MaxPlayers))
      WriteStringN(0, MudName)
      WriteStringN(0, Str(port))
    CloseFile(0)
    PrintN("The server configuration settings have been saved to settings.conf.")
  Else
    OpenFile(0, "settings.conf")
      MaxPlayers = Val(ReadString(0))
      PrintN("Max players is set to: " + Str(MaxPlayers))
      MudName = ReadString(0)
      ConsoleTitle(MudName)
      PrintN("Mud name is set to: " + MudName)
      port = Val(ReadString(0))
      PrintN("Port is set to: " + Str(port))
    CloseFile(0)
  EndIf
  If CreateNetworkServer(0, port, #PB_Network_TCP, "0.0.0.0") = 0
    PrintN("Error: The server could Not be started.")
    End
  EndIf
  PrintN("Server started successfully.")

  Repeat
 
    Inkey()
    If RawKey() = 27
      PrintN("Exit: The server will now close.")
      Exit = #True
    EndIf
 
    Select NetworkServerEvent(0)
      Case #PB_NetworkEvent_Connect
        NetworkConnectEvent(EventClient())
     
      Case #PB_NetworkEvent_Data
        NetworkDataEvent(EventClient())
     
      Case #PB_NetworkEvent_None
        Protected x.i = ListSize(Players())
        Delay(5)
        For x = ListSize(Players()) -1 To 0 Step -1
          SelectElement(Players(), x)        
          If Players()\KeepAlive
            Players()\LastData = Date()
          EndIf        
            If Date() = Players()\ElTime
              SendNetworkString(Players()\CNum, "'")
              Timer(Players())
            EndIf
          If (Players()\QFlag = #True) Or (Players()\LastData < Date() - 180 And Players()\KeepAlive = #False)
            If Players()\QFlag
              MsgAll(Players()\Name, Players()\Name + "has left the game.")
              SelectElement(Players(), x)        
              PrintN("Info: " + Players()\Name + " has chosen to disconnect.")
            Else
            If Players()\Logged = #False
              PrintN("Info: Client " + Str(Players()\CNum) + " disconnected due to inactivity.")
            Else
              PrintN(Players()\Name + " has been disconnected do to inactivity.")
              SendNetworkString(Players()\CNum, "You have been disconnected because you were idle for 3 minutes.")
            EndIf
          EndIf
          CloseNetworkConnection(Players()\CNum)
          DeleteElement(Players())
          If ListSize(Players()) = 0
            ClearList(Players())
          EndIf
        EndIf
      Next
    EndSelect 
  Until Exit
  CloseNetworkServer(0)
EndProcedure

Main()

// Code tags added (Kiffi)

[Quin]

Hey Justin,
Blind PB user myself here.
Firstly as for MK-Soft's suggestion, if you want to make your code indented properly, select all (control+a) in the IDE, and press control+I. This makes it easier for sighted people, and those of us blind users that use indentation beeps, to read it.
Secondly, you don't always need to use replies. In your most recent post you quoted your original message with all the code pasted in, making it mildly annoying to navigate past (quoting does have its place). The way I typically reply to topics is by going past all the post headings, pressing h one more time, then navigating backwards by link (shift+K with NVDA on Windows) until I find the post reply button.

Now your code:
Wow. That's quite some code you've got there. I unfortunately won't have time to properly dissect it until I get back from my Christmas holiday, but for what it's worth, more portions of the debugger are accessible than you think. For example, the variable viewer is at least partially usable, as well as using Debug statements in your code. Maybe try a few of these methods?
Related, maybe we should start actively complaining about these things. Someone complained about menu icons and the status bar reading with a screen reader and Freak added a screen reader mode to the IDE for us, so they actually do seem to care. And, the way I see it, the more blind users asking for it, the better!

[justin.miller423]

Hello Quin,
Thanks for getting back to me. I did put the file link so it would be easier to see what I did and also you'd have access to the database. One of the problems I'm having with it is that now it won't let you create a new user with out crashing. I had a nonthreaded version and it worked good but the problem is its way harder to design subcommands so threading makes that easier for me. I hope this description gives you a better idea as to what's happening. Also thanks for telling me about the variable viewer.
That could be a big help. I hope they add a way for us to tell what screen reader is running. I'd imagine there's probably a way to do it with Windows API calls but I don't know anything about those at all. Lol. Hope you had a Merry Christmas and a good newyear.