A work-in-progress, but it's now to the point that it does the very barest of TCP/IP communication back and forth across the internet.
For those that are brave, you might give this a shot and see how badly it glitches out on you.
I'll leave the host up and running all day, but I may not be around the whole time to chat or interact with anyone, and I don't guarantee that the server won't explode spontaniously and die a horrible death. But, at the moment, it seems stable with an client base of ONE person testing it. LOL!!
Okies... now I have TWO people testing it -- Steve and Steve2! Yay!!
Anyone want to take bets on how long it takes before this simple chat dies and has to be rebooted and restarted?
For those that are brave, you might give this a shot and see how badly it glitches out on you.
Code: (Select All)
OPTION _EXPLICIT
$COLOR:32
CONST Port = "7319", IP = "172.93.60.23"
CONST FullPort = "TCP/IP:" + Port
CONST FullIP = FullPort + ":" + IP
DIM SHARED AS LONG client 'up to 1000 connections
DIM AS STRING recieved
DIM SHARED AS STRING nam
DIM SHARED AS LONG MainDisplay, TextArea, InputArea
DIM SHARED AS _FLOAT NextPing, server_active
DIM SHARED AS _BYTE TimeStamp 'toggle type display variables
DIM SHARED AS _UNSIGNED LONG DefaultColor, AudibleAlert
DIM ChatLen AS LONG, ChatLog AS STRING, tempString AS STRING
MainDisplay = _NEWIMAGE(1280, 720, 32)
TextArea = _NEWIMAGE(1280, 600, 32)
InputArea = _NEWIMAGE(1280, 120, 32)
DefaultColor = White
TimeStamp = -1
AudibleAlert = -1
SCREEN MainDisplay
client = _OPENCLIENT(FullIP)
IF client THEN
PRINT "Connected to Steve's Chat!"
server_active = ExtendedTimer + 300 'server is now counted as being "active" for the next 5 minutes
GET #client, , ChatLen
ChatLog = SPACE$(ChatLen)
DO
GET #client, , tempString
ChatLog = ChatLog + tempString
_LIMIT 30
LOOP UNTIL LEN(ChatLog) >= ChatLen
INPUT "Enter your name =>"; nam
SendMessage "/NAME:" + nam
_KEYCLEAR 'clear the input buffer, Steve, you big idiot!
'_KEYHIT will still hold the name in that buffer as it's independent to INPUT!
CLS
PRINT ChatLog
NextPing = ExtendedTimer
DO ' main program loop
recieved$ = GetMessage
ProcessInput recieved$ ' deal with any server command type messages
IF recieved$ <> "" THEN ' we got something from the clien
_DEST TextArea
IF TimeStamp THEN COLOR Yellow: PRINT "[" + TIME$ + "] ";: COLOR DefaultColor
PRINT recieved$ ' it should just be a message of some sort
END IF
InputJunk
IF ExtendedTimer > NextPing THEN 'send a message to the server that we're still active
SendMessage "/PING:" ' that message is a simple PING
NextPing = ExtendedTimer + 30 'and send this every 30 seconds so we don't disconnect.
END IF
IF ExtendedTimer > server_active THEN
PRINT: PRINT "Sorry. It appears the server has went offline."
PRINT "We are now terminating this chat client."
PRINT: PRINT "Please try back again later."
_DELAY 2: _KEYCLEAR: SLEEP: SYSTEM
END IF
CLS , 0, MainDisplay
_PUTIMAGE (0, 600)-(1279, 719), InputArea, MainDisplay
_PUTIMAGE (0, 0)-(1279, 599), TextArea, MainDisplay
_DISPLAY
_LIMIT 30
LOOP
ELSE
PRINT "Sorry. Could not connect at this time."
PRINT "Check Firewall, port forwarding, or other internet TCP/IP blockades."
END
END IF
SUB ProcessInput (what AS STRING)
SELECT CASE what
CASE "/PING:" 'the server send us back a /PING response
server_active = ExtendedTimer + 300
what = ""
END SELECT
IF AudibleAlert _ANDALSO RIGHT$(what, 22) = " has entered the chat!" THEN BEEP
END SUB
SUB InputJunk
DIM AS LONG k
DIM AS STRING temp
STATIC send$
_DEST InputArea
CLS , LightGray
k = _KEYHIT
SELECT CASE k
CASE ASC("v"), ASC("V")
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
send$ = send$ + _CLIPBOARD$
ELSE
send$ = send$ + CHR$(k)
END IF
CASE 32 TO 255
send$ = send$ + CHR$(k)
CASE 8
send$ = LEFT$(send$, LEN(send$) - 1)
CASE 13
'do some client side command handling, in case we change some local settings ourselves.
temp = _TRIM$(send$)
IF UCASE$(LEFT$(temp, 6)) = "/NAME:" THEN
nam$ = LEFT$(MID$(temp$, 7), 10)
send$ = "/NAME:" + nam$
END IF
IF UCASE$(LEFT$(temp, 12)) = "/TIMESTAMPS:" THEN
send$ = ""
temp$ = UCASE$(_TRIM$(MID$(temp$, 13)))
IF TimeStamp = 0 THEN
IF temp$ = "ON" THEN TimeStamp = -1: SystemMessage "Timestamps are now ON."
ELSE
IF temp$ = "OFF" THEN TimeStamp = 0: SystemMessage "Timestamps are now OFF."
END IF
EXIT SUB
END IF
IF UCASE$(LEFT$(temp, 7)) = "/ALERT:" THEN
send$ = ""
temp$ = UCASE$(_TRIM$(MID$(temp$, 8)))
IF AudibleAlert = 0 THEN
IF temp$ = "ON" THEN AudibleAlert = -1: SystemMessage "Audible Alerts are now ON, for when people join the server."
ELSE
IF temp$ = "OFF" THEN AudibleAlert = 0: SystemMessage "Audible Alerts are now OFF, for when people join the server."
END IF
EXIT SUB
END IF
SELECT CASE UCASE$(temp)
CASE "/QUIT", "EXIT", "/QUIT:", "/EXIT:"
SendMessage "/EXIT:"
SYSTEM
CASE "/USERS", "/USER", "/LIST", "/USERS:", "/USER:", "/LIST:", "/USERLIST", _
"/USERSLIST", "/USERLIST:", "/USERSLISTS:"
SendMessage "/USERLIST:"
send$ = ""
END SELECT
IF send$ <> "" THEN SendMessage send$
send$ = ""
END SELECT
IF TimeStamp THEN COLOR Yellow: PRINT "[" + TIME$ + "] ";: COLOR DefaultColor
PRINT nam + ": " + send$ + " (" + STR$(LEN(send$)) + "/65500)"
_DEST TextArea
IF _EXIT THEN
SendMessage "/EXIT:"
SYSTEM
END IF
END SUB
SUB SystemMessage (sysmes AS STRING)
_DEST TextArea
COLOR Yellow
PRINT sysmes
COLOR DefaultColor
_DEST InputArea
END SUB
SUB SendMessage (msg AS STRING)
DIM AS STRING temp
DIM AS _UNSIGNED INTEGER i
msg = LEFT$(msg, 65535)
i = LEN(msg)
IF i = 0 THEN EXIT SUB 'don't bother sending blank messages.
temp = MKI$(i) + msg
PUT client, , temp
_DELAY .1 'wait a moment before we return to get/send more messages
msg = "" 'reset to blank after we send it
END SUB
FUNCTION GetMessage$
DIM AS _UNSIGNED _BYTE b
DIM AS _UNSIGNED INTEGER i
DIM AS STRING recieved
GET #client, , i
recieved = SPACE$(i)
GET #client, , recieved
GetMessage = recieved
END FUNCTION
FUNCTION ExtendedTimer##
'Simplified version of the TimeStamp routine, streamlined to only give positive values based on the current timer.
'Note: Only good until the year 2100, as we don't do all the fancy calculations for leap years.
'A timer should work quickly and efficiently in the background; and the less we do, the less lag we might insert
'into a program.
DIM m AS INTEGER, d AS INTEGER, y AS INTEGER
DIM s AS _FLOAT, day AS STRING
day = DATE$
m = VAL(LEFT$(day, 2))
d = VAL(MID$(day, 4, 2))
y = VAL(RIGHT$(day, 4)) - 1970
SELECT CASE m 'Add the number of days for each previous month passed
CASE 2: d = d + 31
CASE 3: d = d + 59
CASE 4: d = d + 90
CASE 5: d = d + 120
CASE 6: d = d + 151
CASE 7: d = d + 181
CASE 8: d = d + 212
CASE 9: d = d + 243
CASE 10: d = d + 273
CASE 11: d = d + 304
CASE 12: d = d + 334
END SELECT
IF (y MOD 4) = 2 AND m > 2 THEN d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
ExtendedTimer## = (s + TIMER)
END FUNCTION
I'll leave the host up and running all day, but I may not be around the whole time to chat or interact with anyone, and I don't guarantee that the server won't explode spontaniously and die a horrible death. But, at the moment, it seems stable with an client base of ONE person testing it. LOL!!
Okies... now I have TWO people testing it -- Steve and Steve2! Yay!!
Anyone want to take bets on how long it takes before this simple chat dies and has to be rebooted and restarted?