Uru RealLife Community
Die größte deutschsprachige Uru-Community / The largest German Uru Community
Letzter Beitrag der vorhergehenden Seite:
Also mir gefällt "Zurückstellen" am besten. "Reset" finde ich an der Stelle nicht so gut, weil ich darunter ein Rücksetzen auf einen festen Ausgangszustand verstehe. Die "Zurück"-Taste bewirkt aber nur ein Zurückstellen auf den vorherigen Zustand der Einstellungen.
Tut er ja auch!TheSearcher hat geschrieben:Ich wäre vermutlich in der Lage einen Lobby-Server in Java zu schreiben. Aber Modi wollte das doch übernehmen...
Ich habe übrigens einen "eleganteren" Weg gefunden, den Lobby-Server zu realisieren - und zwar per PHP. Vorteil: Man kann die Lobby auf jedem Web-Server laufen lassen, der PHP unterstützt und eine MySQL-Datenbank besitzt.Code: Alles auswählen
).<?php
// Generic PHP-based lobby server
// by The.Modificator
// This is free code. Use it however you want, but please give credits where credits have to be given.
unset($setup); unset($createdb); unset($dbserver); unset($dbuser); unset($dbpassword); unset($dbname);
////////////////////////////////////////////////////////////////////////////////////////////////////
// Change values below
////////////////////////////////////////////////////////////////////////////////////////////////////
$dbserver = "localhost"; // database hostname
$dbuser = "root"; // database username
$dbpassword = ""; // database password
$dbname = "dudos"; // database name
//Just change this value once to 1 to setup the database
$setup = 0;
$createdb = 0; // if your provider supports the "CREATE DATABASE" command, you can also change
// this value to 1
////////////////////////////////////////////////////////////////////////////////////////////////////
// Change values above
////////////////////////////////////////////////////////////////////////////////////////////////////
if($setup == 1)
{
if(!($dbcid = mysql_connect($dbserver, $dbuser, $dbpassword)))
{
exit("ERR\nCould not connect.");
}
if($createdb == 1)
{
$sql="CREATE DATABASE `$dbname`;";
mysql_query($sql,$dbcid);
}
if(!mysql_select_db($dbname))
{
exit("ERR\nCould not select the db.");
}
$sql="CREATE TABLE `$dbname`.`servers` (
`server_ip` VARCHAR(255) NOT NULL,
`last_signal_time` INTEGER UNSIGNED NOT NULL,
`game_name` VARCHAR(255) NOT NULL,
PRIMARY KEY(`server_ip`)
);";
mysql_query($sql,$dbcid);
mysql_close($dbcid);
echo("OK\nDatabase should be up now. Change the \$setup and the \$createdb values back to 0 now.");
exit();
}
if(isset($HTTP_GET_VARS['command'])||isset($HTTP_POST_VARS['command']))
{
$command = isset($HTTP_GET_VARS['command'])?$HTTP_GET_VARS['command']:$HTTP_POST_VARS['command'];
}
else
{
exit("ERR\nNo command specified");
}
if(!($dbcid = mysql_connect($dbserver, $dbuser, $dbpassword)))
{
exit("ERR\nCould not connect.");
}
if(!mysql_select_db($dbname))
{
exit("ERR\nCould not select the db.");
}
$ip = $HTTP_SERVER_VARS['REMOTE_ADDR'];
$time = time();
$toolate = $time - 2*60;
if($command=="refresh")
{
$gamename_unesc = isset($HTTP_GET_VARS['gamename']) ? $HTTP_GET_VARS['gamename'] : $HTTP_POST_VARS['gamename'];
$gamename = mysql_escape_string($gamename_unesc);
}
//delete servers that timed out
$sql = "DELETE FROM `servers` WHERE `last_signal_time` < $toolate;";
mysql_query($sql,$dbcid);
switch($command)
{
case "newserver":
$sql = "INSERT INTO `servers` (`server_ip`,`last_signal_time`,`game_name`) VALUES ('$ip', '$time','');";
mysql_query($sql,$dbcid);
echo "OK\n";
break;
case "refresh":
$sql = "UPDATE `servers` SET `last_signal_time` = $time, `game_name` = '$gamename' WHERE `server_ip` = '$ip';";
mysql_query($sql,$dbcid);
echo "OK\n";
break;
case "removeserver":
$sql = "DELETE FROM `servers` WHERE `server_ip` = '$ip';";
mysql_query($sql,$dbcid);
echo "OK\n";
break;
case "getservers":
$sql = "SELECT `server_ip`,`last_signal_time`,`game_name` FROM servers;";
$ret = mysql_query($sql,$dbcid);
//$count = mysql_num_rows($ret);
echo "OK\n";
while($data = mysql_fetch_array($ret))
{
echo $data['server_ip'];
echo ",";
echo str_replace("\n","&br;",str_replace("&","&",$data['game_name']));
echo "\n";
};
echo "END";
break;
default:
exit("ERR\nNo command specified");
}
mysql_close($dbcid);
?>
Code: Alles auswählen
Option Explicit
' VB client for the generic PHP-based lobby server
' by The.Modificator
' This is free code. Use it however you want, but please give credits where credits have to be given.
Private Declare Function GetTickCount Lib "kernel32" () As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Change values below
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const HTTP_Host As String = "localhost"
Const HTTP_Path As String = "dudoslobby.php"
Const HTTP_Port As Long = 80
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Change values above
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private http As Winsock
Private DataArrived As String
Private Connected As Boolean
Private LobbyInUse As Boolean
Public Sub LobbyWinsockConnect()
Connected = True
End Sub
Public Sub LobbyWinsockDataArrival(ByVal bytesTotal As Long)
http.GetData DataArrived
End Sub
Private Function WaitForData()
Dim Start As Long
Dim I&
Start = GetTickCount()
Do
For I = 1 To 100: DoEvents: Next
If DataArrived <> "" Then WaitForData = 1: Exit Function
Loop While Start > GetTickCount() - 30000
WaitForData = 0
End Function
Private Function WaitForConnection()
Dim Start As Long
Dim I&
Start = GetTickCount()
Do
For I = 1 To 100: DoEvents: Next
If Connected = True Then WaitForConnection = 1: Exit Function
Loop While Start > (GetTickCount() - 30000)
WaitForConnection = 0
End Function
Private Function HexA(inp As Byte) As String
If (Len(Hex(inp)) = 1) Then HexA = "0" & Hex(inp) Else HexA = Hex(inp)
End Function
Private Function EncodeForWeb(inp As String) As String
Dim I&
For I = 1 To Len(inp)
If ((Mid(inp, I, 1) = vbCr) Or (Mid(inp, I, 1) = vbLf)) Then GoTo NextOne
EncodeForWeb = EncodeForWeb & "%" & Hex(Asc(Mid(inp, I, 1)))
NextOne:
Next
End Function
Public Function LobbyGetServers() As String()
If LobbyInUse Then GoTo ErrorOut
LobbyInUse = True
Dim ret As Long
http.Close
http.Connect HTTP_Host, HTTP_Port
Connected = False
ret = WaitForConnection()
If ret = 0 Then GoTo ErrorOut
DataArrived = ""
http.SendData "GET /" & HTTP_Path & "?command=getservers HTTP/1.0" & vbCrLf & _
"Host: " & HTTP_Host & vbCrLf & _
"User-Agent: DUDOS/" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & _
"Connection: close" & vbCrLf & _
vbCrLf
ret = WaitForData()
If ret = 1 Then
Dim DataPos As Long
DataPos = InStr(1, DataArrived, vbCrLf & vbCrLf)
If DataPos = 0 Then GoTo ErrorOut
Dim Lines() As String
Lines = Split(Mid(DataArrived, DataPos + 4), vbLf)
If (UBound(Lines) > 1) Then
For ret = 1 To UBound(Lines) - 1
Lines(ret) = Replace(Lines(ret), "&br;", vbNewLine)
Lines(ret) = Replace(Lines(ret), "&", "&")
Next
End If
LobbyGetServers = Lines
Else
GoTo ErrorOut
End If
http.Close
LobbyInUse = False
Exit Function
ErrorOut:
Dim LGetServers(1) As String
LGetServers(1) = "ERR"
LobbyGetServers = LGetServers
http.Close
LobbyInUse = False
End Function
Public Function LobbyNewServer() As Long
If LobbyInUse Then GoTo ErrorOut
LobbyInUse = True
Dim ret As Long
http.Close
http.Connect HTTP_Host, HTTP_Port
Connected = False
ret = WaitForConnection()
If ret = 0 Then GoTo ErrorOut
DataArrived = ""
http.SendData "GET /" & HTTP_Path & "?command=newserver HTTP/1.0" & vbCrLf & _
"Host: " & HTTP_Host & vbCrLf & _
"User-Agent: DUDOS/" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & _
"Connection: close" & vbCrLf & _
vbCrLf
ret = WaitForData()
If ret = 1 Then
Dim DataPos As Long
DataPos = InStr(1, DataArrived, vbCrLf & vbCrLf)
If DataPos = 0 Then GoTo ErrorOut
If (Mid(DataArrived, DataPos + 4, 2)) <> "OK" Then LobbyNewServer = 0 Else LobbyNewServer = 1
Else
GoTo ErrorOut
End If
http.Close
LobbyInUse = False
Exit Function
ErrorOut:
LobbyNewServer = 0
http.Close
LobbyInUse = False
End Function
Public Function LobbyUpdateServer(GameName As String) As Long
If LobbyInUse Then GoTo ErrorOut
LobbyInUse = True
Dim ret As Long
http.Close
http.Connect HTTP_Host, HTTP_Port
Connected = False
ret = WaitForConnection()
If ret = 0 Then GoTo ErrorOut
DataArrived = ""
http.SendData "GET /" & HTTP_Path & "?command=refresh&gamename=" & EncodeForWeb(GameName) & " HTTP/1.0" & vbCrLf & _
"Host: " & HTTP_Host & vbCrLf & _
"User-Agent: DUDOS/" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & _
"Connection: close" & vbCrLf & _
vbCrLf
ret = WaitForData()
If ret = 1 Then
Dim DataPos As Long
DataPos = InStr(1, DataArrived, vbCrLf & vbCrLf)
If DataPos = 0 Then GoTo ErrorOut
If (Mid(DataArrived, DataPos + 4, 2)) <> "OK" Then LobbyUpdateServer = 0 Else LobbyUpdateServer = 1
Else
GoTo ErrorOut
End If
http.Close
LobbyInUse = False
Exit Function
ErrorOut:
LobbyUpdateServer = 0
http.Close
LobbyInUse = False
End Function
Public Function LobbyRemoveServer() As Long
If LobbyInUse Then GoTo ErrorOut
LobbyInUse = True
Dim ret As Long
http.Close
http.Connect HTTP_Host, HTTP_Port
Connected = False
ret = WaitForConnection()
If ret = 0 Then GoTo ErrorOut
DataArrived = ""
http.SendData "GET /" & HTTP_Path & "?command=removeserver HTTP/1.0" & vbCrLf & _
"Host: " & HTTP_Host & vbCrLf & _
"User-Agent: DUDOS/" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & _
"Connection: close" & vbCrLf & _
vbCrLf
ret = WaitForData()
If ret = 1 Then
Dim DataPos As Long
DataPos = InStr(1, DataArrived, vbCrLf & vbCrLf)
If DataPos = 0 Then GoTo ErrorOut
If (Mid(DataArrived, DataPos + 4, 2)) <> "OK" Then LobbyRemoveServer = 0 Else LobbyRemoveServer = 1
Else
GoTo ErrorOut
End If
http.Close
LobbyInUse = False
Exit Function
ErrorOut:
LobbyRemoveServer = 0
http.Close
LobbyInUse = False
End Function
Public Sub LobbySetWinsock(wsk As Winsock)
Set http = wsk
End Sub
Code: Alles auswählen
Private Sub cmdGetServers_Click()
Dim z() As String
z = LobbyGetServers()
If z(1) <> "OK" Then
'Fehler... Abbruch
MsgBox "Error"
Exit Sub
End If
lstServers.Clear
Dim I&
For I = 1 To UBound(z) - 1
lstServers.AddItem z(I)
Next
'... hier können die Server z.B. zu einem List-Steuerelement hinzugefügt werden
End Sub
Private Sub cmdAddMe_Click()
Dim z As Long
z = LobbyNewServer()
If z = 0 Then
'Fehler... Abbruch
MsgBox "Error"
Exit Sub
End If
z = LobbyUpdateServer(txtGameName.Text)
If z = 0 Then
'Fehler...
MsgBox "Error"
End If
End Sub
Private Sub cmdUpdateName_Click()
Dim z As Long
z = LobbyUpdateServer(txtGameName.Text)
If z = 0 Then
'Fehler...
MsgBox "Error"
End If
End Sub
Private Sub cmdRemoveMe_Click()
Dim z As Long
z = LobbyRemoveServer()
If z = 0 Then
'Fehler...
MsgBox "Error"
End If
End Sub
Private Sub Form_Load()
LobbySetWinsock Winsock1
End Sub
Private Sub Winsock1_Connect()
LobbyWinsockConnect
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
LobbyWinsockDataArrival bytesTotal
End Sub
Da muss ich nur noch ein paar "kleine Ergänzungen" machen und schon ist ein erstes Testprogramm fertig. 
Ich habe auch schon eine brauchbare Vorstellung davon, wie das alles ins DUDOS-Programm eingebunden werden kann, würde aber trotzdem vorher erst mal ein Testprogramm schreiben, welches nur die Funktionen des Lobby-Servers beinhaltet. 
