'********************************************************************************
'* Leaderboard Server v1.0 5/9/20
'*
'* This will keep track, back up, and service up to 100 clients at the same time
'* Can also write to a website if you wish
'* Requires ipcommsg.bi from ipcomtools
'*
'********************************************************************************
GamesServiced = 1 'Changes how many games the server currently handles
DIM SHARED Leaderboard
(GamesServiced
, 20) AS LeaderBoardObject
ON TIMER(UpdateTimer
, 300) UpdateServer
'backs up every 5 minutes
LoadDatabase
IF NEWCLIENT
THEN 'when client connects. if it has an open spot will accept connection IF ClientInfo
(x
).Active
= 0 THEN Client(x) = NEWCLIENT
ClientInfo
(x
).ColR
= INT(RND * 155) + 100 ClientInfo
(x
).ColG
= INT(RND * 155) + 100 ClientInfo
(x
).ColB
= INT(RND * 155) + 100 ClientInfo(x).Active = 1
FOR Scan
= 1 TO 100 'find if any new messages are waiting from each of the clients
COLOR _RGB(ClientInfo
(Scan
).ColR
, ClientInfo
(Scan
).ColG
, ClientInfo
(Scan
).ColB
) IF ClientInfo
(Scan
).Active
= 1 THEN MSG$
= WAITFORREPLY$
(Client
(Scan
))
'********************************************************************************
' Code for recieving a new high score
'********************************************************************************
SENDMSG Client(Scan), "GAMENO"
GameID
= VAL(WAITFORREPLY$
(Client
(Scan
))) SENDMSG Client(Scan), "OK"
User$ = WAITFORREPLY$(Client(Scan))
'CheckIfUserBanned
SENDMSG Client(Scan), "SCORE"
Score
= VAL(WAITFORREPLY$
(Client
(Scan
)))
Position = 0
IF Score
> Leaderboard
(GameID
, x
).Score
THEN Position
= x:
EXIT FOR
Leaderboard(GameID, x).Score = Leaderboard(GameID, x - 1).Score
Leaderboard(GameID, x).User = Leaderboard(GameID, x - 1).User
Leaderboard(GameID, Position).Score = Score
Leaderboard(GameID, Position).User = User$
IF GameID
= 1 THEN PRINT "Stereospace2 Board Updated by:"; ClientInfo
(Scan
).IP
MSG$ = ""
'********************************************************************************
' Code for when client requests the scoreboard
'********************************************************************************
SENDMSG Client(Scan), "GAMENO"
GameID
= VAL(WAITFORREPLY$
(Client
(Scan
))) SENDMSG Client(Scan), "OK"
IF WAITFORREPLY$
(Client
(Scan
)) = "NAME" THEN SENDMSG Client
(Scan
), RTRIM$(Leaderboard
(GameID
, x
).User
) IF WAITFORREPLY$
(Client
(Scan
)) = "SCORE" THEN SENDMSG Client
(Scan
), STR$(Leaderboard
(GameID
, x
).Score
) IF WAITFORREPLY$
(Client
(Scan
)) = "OK" THEN SENDMSG Client
(Scan
), "NEXT" SENDMSG Client(Scan), "DONE"
IF GameID
= 1 THEN PRINT "Stereospace2 Board Sent to:"; ClientInfo
(Scan
).IP
MSG$ = ""
'********************************************************************************
' Code for when client requests to close connection
'********************************************************************************
SENDMSG Client(Scan), "GOODBYE"
ClientInfo(Scan).Active = 0
PRINT "Connection to: ";
RTRIM$(ClientInfo
(Scan
).IP
);
" closed." MSG$ = ""
'********************************************************************************
' Code for when client requests to be verified
'********************************************************************************
'CheckIfIPIsBanned
SENDMSG Client(Scan), "OK"
IF WAITFORREPLY$
(Client
(Scan
)) = "READY" THEN Tmp
= INT(RND * 256) + 1 'generate random number for verification SENDMSG Client
(Scan
), STR$(Tmp
) 'send number to client 'PW = 'insert math to manipulate random number. Make sure client has same formula
Test
= VAL(WAITFORREPLY$
(Client
(Scan
))) 'wait for client to send verification code IF PW
= Test
THEN ' if client got same result as server then verified SENDMSG Client(Scan), "LOCKED"
PRINT "Connection to: ";
RTRIM$(ClientInfo
(Scan
).IP
);
" Locked." PRINT "Got:"; Test;
" instead of"; PW;
"disconnecting" ClientInfo(Scan).Active = 0
PRINT "Connection to: ";
RTRIM$(ClientInfo
(Scan
).IP
);
" closed." MSG$ = ""
'********************************************************************************
' Backs up server, checks if connections are still active
'********************************************************************************
PRINT "Checking all active connections" IF ClientInfo
(x
).Active
= 1 THEN SENDMSG Client(x), "PING"
IF WAITFORREPLY$
(Client
(x
)) <> "PONG" THEN ClientInfo(x).Active = 0
PRINT "Connection to: ";
RTRIM$(ClientInfo
(x
).IP
);
" closed."
PRINT "Backing up database"
FOR x
= 1 TO GamesServiced
IF x
= 1 THEN File$
= "Stereospace2.dat" PRINT #1, Leaderboard
(x
, y
).Score
PRINT "Writing to web server" WriteWebsite
'********************************************************************************
' Loads backed up leaderboards from all games
'********************************************************************************
FOR x
= 1 TO GamesServiced
IF x
= 1 THEN File$
= "Stereospace2.dat" INPUT #1, Leaderboard
(x
, y
).User
INPUT #1, Leaderboard
(x
, y
).Score
'********************************************************************************
' Website code for server. must edit
'********************************************************************************
'OPEN "C:\inetpub\wwwroot\Scores.html" FOR OUTPUT AS #1
'PRINT #1, "<html>"
'PRINT #1, "<head>"
'PRINT #1, "<link rel="; CHR$(34); "stylesheet"; CHR$(34); " type="; CHR$(34); "text/css"; CHR$(34); " href="; CHR$(34); "css/style.css"; CHR$(34); " />"
'PRINT #1, "</head>"
'PRINT #1, "<body>"
'PRINT #1, "<br><br>"
'PRINT #1, "<center>"
'PRINT #1, "<table width=80% border=0>"
'PRINT #1, "<tr><td>Stereospace 2</tr></td>"
'FOR y = 1 TO 20
' PRINT #1, "<tr><td>"
'PRINT #1, RTRIM$(Leaderboard(1, y).User); "</td><td>"; Leaderboard(1, y).Score; "</tr></td>"
'NEXT y
'PRINT #1, "</table>"
'PRINT #1, "</body>"
'PRINT #1, "<body>"
'PRINT #1, "</html>"
'CLOSE #1
'$include:'ipcommsg.bi'
Show Posts
