' A "filtered" Chat Server by William Yu
' Clients can connect to this server, and talk to each other, but
' what gets filtered out are all those nasty swear words!
' If you've never programmed with sockets before, don't worry, this is
' as easy as it gets... sort of.

' Brief Overview of QSocket  (Server-side)
'    -- It is an interface only
'
'  Transferred AS INTEGER
'       -- Poll this value after any Read/Write
'       -- Returns number of bytes sent/received
'  Open(PortNum AS INTEGER)
'       -- Used only by server, opens a TCP/IP connection
'       -- Returns a socket file descriptor, store it!
'  Accept(MasterSocket AS INTEGER)
'       -- This function will block until a connection is established
'       -- Returns a client socket file descriptor
'  ConnectionReady(MasterSocket AS INTEGER)
'       -- This function just checks if a connection is pending
'       -- If so, then you should Accept the connection.
'       -- This is a non-blocking function call, returns 0 if no connection is ready.
'  IsClientReady(MasterSocket AS INTEGER, ClientSocket AS INTEGER)
'       -- Non-blocking function call that determines if a client has sent
'          some data to the "MasterSocket"
'  ReadLine(ClientSocket AS INTEGER) AS STRING
'       -- Read a complete line (ended with a linefeed character)
'       -- Returns the line read, from the ClientSocket.
'       -- Always check Socket.Transferred after this read operation.
'       -- If Transferred = -1 then an error has occurred (client disconnected).
'  WriteLine(ClientSocket AS INTEGER, Message AS STRING) AS INTEGER
'       -- Function call that sends a message over to the client.
'       -- Returns LEN(Message) on success, -1 on failure
' ReadBytes/WriteBytes will be implemented later, I just felt like
' releasing this as is (because of some memory leaks).


$APPTYPE GUI
$ESCAPECHARS ON
$TYPECHECK ON         '' I get in so many trouble with it OFF!!!
$INCLUDE <RapidQ2.inc>

CONST DELAY = 500     ' In Milliseconds
CONST PortNum = 80 '5000  ' Anything above 1024 should work, with some exceptions
'CONST False = 0
'CONST True = NOT False
CONST filename$ = "index.html"

DECLARE SUB TimerExpired
DECLARE SUB Resize

DIM Socket AS QSocket

CREATE Form AS QForm
  Height = 310
  Width = 400
  Caption = "Chat Server"
'  Center
  OnResize = Resize
  CREATE ListBox AS QRichEdit 'QListBox 
    Top = 80
    Height = 200
    Width = Form.ClientWidth
'    AddItems "Chat server by William Yu", STRING$(30,"-")
    AddStrings "Chat server by William Yu", STRING$(30,"-")
'    ItemIndex = 0
  END CREATE
  CREATE Label1 AS QLabel
    Top = 10
    Left = 10
    Height = 14
    Caption = "Server: " + Socket.GetHostName
  END CREATE
  CREATE Label2 AS QLabel
    Top = 29
    Left = 10
    Height = 14
    Caption = "Port: "+STR$(PortNum)
  END CREATE
  CREATE Label3 AS QLabel
    Top = 48
    Left = 10
    Height = 14
    Caption = "Connections: 0"
  END CREATE
END CREATE

DIM Timer1 AS QTimer
DIM File AS QFileStream
DIM MasterSocket AS INTEGER, NumClients AS INTEGER
DIM Client(1 TO 50) AS INTEGER
DIM SwearCount AS INTEGER
DIM Swears(1 TO 50) AS STRING
    Swears(1) = "ASS"
    Swears(2) = "BASTARD"
    Swears(3) = "HELL"     ' Yeah, I'm skipping the most obvious :)
    ' Add yours here, I'm keeping this code "clean"
    SwearCount = 3

Timer1.Interval = DELAY    ' Some Delay between checks
                           ' Don't want to become a CPU hog
Timer1.OnTimer = TimerExpired

NumClients = 0
MasterSocket = Socket.Open(PortNum)

IF MasterSocket = -1 THEN
  PRINT "Server error: could not make connection, maybe try another port..."
  END
END IF

Form.ShowModal

SUB SwapClients(N AS INTEGER)
'-- Get rid of disconnected client

  DIM I AS INTEGER

  FOR I = N to NumClients
    Client(I) = Client(I+1)
  NEXT
END SUB

FUNCTION Filter(Message AS STRING) AS STRING
  DIM I AS INTEGER, N AS INTEGER
  DIM X AS INTEGER, Y AS INTEGER

  ' Very very simple, you should write your own filter, as this is just a
  ' demonstration, GRASS and ASS will both be processed!

  FOR I = 1 To SwearCount
    '' Dang, seems to seg fault sometimes...
    N = INSTR(UCASE$(Message), Swears(I))
    WHILE N
      Message = LEFT$(Message, N-1) + STRING$(LEN(Swears(I)), "*") + _
                MID$(Message, N+LEN(Swears(I)), LEN(Message))
      N = INSTR(UCASE$(Message), Swears(I))
    WEND
  NEXT I

  Filter = Message
END FUNCTION

SUB SendToClients (Message AS STRING)
  DIM I AS INTEGER, N AS INTEGER

  FOR I = 1 to NumClients
    N = Socket.WriteLine(Client(I), Message)
  NEXT
END SUB


SUB SendHtmlDoc (I AS integer)
ListBox.AddStrings "sending"
	  IF File.Open(filename$, fmOpenRead) <> False THEN
		Socket.WriteLine(Client(I), "HTTP/1.1 200 OK\r\n")
		WHILE File.EOF = False
			Socket.WriteLine(Client(I), File.ReadLine + "\r\n")
		WEND
		File.Close
			Socket.WriteLine(Client(I), "\r\n")
ListBox.AddStrings "Done sending"
	  ELSE
ListBox.AddStrings "file not found"
		Socket.WriteLine(Client(I), "HTTP/1.1 404 Not found\r\n")
      END IF
END SUB


SUB TimerExpired
  DIM I AS INTEGER
  DIM S AS STRING

  Timer1.Enabled = False
  Timer1.Interval = DELAY      ' Restore delay
  IF Socket.ConnectionReady(MasterSocket) > 0 THEN
    NumClients = NumClients + 1
    Client(NumClients) = Socket.Accept(MasterSocket)
    ListBox.AddStrings "Client "+STR$(NumClients)+": Connected to server."
    IF Socket.WriteLine(Client(NumClients), "Welcome to William's Chat Server!") = -1 THEN
       ListBox.AddStrings "Client "+STR$(NumClients)+": Disconnected from server."
       NumClients = NumClients - 1
    ELSE
       Label3.Caption = "Connections: "+STR$(NumClients)
    END IF
  END IF

  FOR I = 1 to NumClients       '' Check for ready clients
    IF Socket.IsClientReady(MasterSocket, Client(I)) > 0 THEN
      S = ""
'      S = S + Socket.Peek( Client(I), 5)
      S = S + Socket.ReadLine(Client(I))
      ListBox.AddStrings "Client "+STR$(I)+"sent : "+S
      IF Socket.Transferred = -1 THEN
         ListBox.AddStrings "Client "+STR$(I)+": Disconnected from server."
         NumClients = NumClients - 1
         Label3.Caption = "Connections: "+STR$(NumClients)
         SwapClients(I)
         SendToClients("Client "+STR$(I)+": Disconnected.")
      ELSE
'         S = Filter(S)
        IF INSTR(UCASE$(S), ".HTML") THEN SendHtmlDoc(I) 'pFlag = True
'        SendToClients("Client "+STR$(I)+": "+S)
      END IF
    END IF
  NEXT I
  Timer1.Enabled = True
END SUB

SUB Resize
    ListBox.Width = Form.ClientWidth
    ListBox.Height = Form.ClientHeight - 110
END SUB