VB 5/6-Tipp 0523: CounterStrike-Serverdaten auslesen

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.
' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
' ------------- Anfang Projektdatei Projekt1.vbp -------------
' Die Komponente ' (MSWINSCK.OCX)' wird benötigt.
' --------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Windows Socket "Winsock1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

Private Sub Command1_Click()

    ' Daten an den Server Senden
    HLServer.SendDataRequest Winsock1, Text1.Text
    
End Sub

Private Sub Form_Load()

    ' Ein Wisock öffnen
    Winsock1.Protocol = sckUDPProtocol
    
    DoEvents
    
    Winsock1.Bind 19822
    
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Dim DIEDATEN As Variant
    
    ' Der Server antwortet
    Winsock1.GetData DIEDATEN
    SetServerData DIEDATEN
    Label1.Caption = "Servername: " & DerServer.Servername
    
End Sub

' ---------- Ende Formular "Form1" alias Form1.frm  ----------
' -------- Anfang Modul "HLServer" alias HLServer.bas --------
' HalfLife Server abfragen
' Details
Enum PB_Satus
    IS_Deactivated = 0
    IS_Req = 1
    IS_Optional = 2
End Enum

Type RuleList
    RuleName As String
    RuleValue As String
End Type

Type SpielerList
    SName As String
    SFrags As Integer
    STime As Single
End Type

Type HL_Server
    RulesCount As Integer
    PunkbusterStatus As PB_Satus
    Reserved_Slots As Integer
    ServerAddress As String
    Servername As String
    ServerMap As String
    GameDirectory As String
    GameName As String
    ActiveClients As Integer
    MaxClients As Integer
    Dedicated As Boolean
    OperationSystem As String
    ServerNeedPassword As Boolean
    GamerCount As Integer
    Gamer(0 To 128) As SpielerList
    Rules(0 To 1024) As RuleList
End Type

Global DerServer As HL_Server

Dim POS As Integer
Dim Status As String
Dim LServerAddress As String
Dim LServername As String
Dim LServerMap As String
Dim LGameDirectory As String
Dim LGameInfo As String
Dim LActiveClients As Integer
Dim LMaxClients As Integer
Dim LProtokollVersion As Integer
Dim LServerType As String
Dim LOperationSystem As String
Dim LServerPassword As Integer
Dim LRunningMod As Integer

' Players
Dim PActivePlayers As Integer
Dim PClientNumber(1 To 128) As Byte
Dim PClientName(1 To 128) As String
Dim PTotalfrags(1 To 128) As Long
Dim PGametime(1 To 128) As Single

' Rules
Dim RCurrentRules As Integer
Dim RRule(1 To 1024) As String
Dim RRuleValue(1 To 1024) As String

' Serverlist
Public GServername(0 To 1024) As String
Public GServerAddress(0 To 1024) As String
Public GPasswort(0 To 1024) As String
Public GMaxServer

Public Sub SetServerData(data)

    Dim PfadDerDatDateien As String
    
    If App.Path Like "*\" Then PfadDerDatDateien = App.Path Else _
        PfadDerDatDateien = App.Path & "\"
        
    ' Server Daten auswerten
    ' Details
    LServerAddress = ""
    LServername = ""
    LServerMap = ""
    LServerType = ""
    LGameDirectory = ""
    LGameInfo = ""
    LActiveClients = -1
    LMaxClients = -1
    LProtokollVersion = 0
    LOperationSystem = ""
    LServerPassword = -1
    LRunningMod = 0
    
    ' Players
    For i = 1 To 128
    
        PClientNumber(i) = 0
        PClientName(i) = Chr$(1)
        PTotalfrags(i) = -1
        PGametime(i) = -1
        
    Next
    
    ' Rules
    For i = 1 To 1000
    
        RRule(i) = Chr$(1)
        RRuleValue(i) = Chr$(1)
        
    Next
    
    ' Pointer initalisieren
    POS = 4
    
    ' Ping
    If (Chr(data(POS)) = "j") Then
    
        Debug.Print "Ping wurde empfangen!!!"
        
    End If
    
    ' Pointer initalisieren
    POS = 4
    
    ' Wenn Details kommen auswerten
    DatNr = FreeFile
    
    If (Chr(data(POS)) = "m") Then
    
        Open PfadDerDatDateien & "hldata.dat" For Binary As DatNr
        Put DatNr, 1, data
        Close DatNr
        POS = POS + 1
        
        While (data(POS) <> 0)
        
            LServerAddress = LServerAddress & Chr(data(POS))
            POS = POS + 1
            
        Wend
        
        POS = POS + 1
        
        While (data(POS) <> 0)
        
            LServername = LServername & Chr(data(POS))
            POS = POS + 1
            
        Wend
        
        POS = POS + 1
        
        While (data(POS) <> 0)
        
            LServerMap = LServerMap & Chr(data(POS))
            POS = POS + 1
            
        Wend
        
        POS = POS + 1
        
        While (data(POS) <> 0)
        
            LGameDirectory = LGameDirectory & Chr(data(POS))
            POS = POS + 1
            
        Wend
        
        POS = POS + 1
        
        While (data(POS) <> 0)
        
            LGameInfo = LGameInfo & Chr(data(POS))
            POS = POS + 1
            
        Wend
        
        POS = POS + 1
        LActiveClients = data(POS)
        POS = POS + 1
        LMaxClients = data(POS)
        POS = POS + 1
        LProtokollVersion = data(POS)
        POS = POS + 1
        LServerType = Chr(data(POS))
        POS = POS + 1
        LOperationSystem = Chr(data(POS))
        POS = POS + 1
        LServerPassword = data(POS)
        POS = POS + 1
        LRunningMod = data(POS)
        Status = "m"
        
    End If
    
    ' Pointer initalisieren
    POS = 4
    
    ' Wenn Players kommen auswerten
    Dim frags(0 To 3) As Byte
    Dim datum(0 To 3) As Byte
    
    If (Chr(data(POS)) = "D") Then
    
        Open PfadDerDatDateien & "Data.dat" For Binary As #1
        Put #1, , data
        Close #1
        POS = POS + 1
        PActivePlayers = data(POS)
        POS = POS + 1
        
        For i = 1 To PActivePlayers
        
            PClientNumber(i) = data(POS)
            POS = POS + 1
            
            While (data(POS) <> 0)
            
                PClientName(i) = PClientName(i) & Chr(data(POS))
                POS = POS + 1
                
            Wend
            
            POS = POS + 1
            
            If (data(POS + 1) = 255) Then
            
                PTotalfrags(i) = data(POS) - 256
                
            Else
            
                PTotalfrags(i) = data(POS)
                
            End If
            
            Debug.Print data(POS)
            Debug.Print data(POS + 1)
            Debug.Print VarType(PTotalfrags(i))
            POS = POS + 4
            
            PGametime(i) = CSng(data(POS) & data(POS + 1) & data(POS + 2) & _
                data(pos4))
                
            POS = POS + 4
            
        Next
        
        Status = "D"
        
    End If
    
    ' Pointer initalisieren
    POS = 4
    
    ' Rules auslesen
    If (Chr(data(POS)) = "E") Then
    
        POS = POS + 1
        RCurrentRules = data(POS) + data(POS + 1)
        POS = POS + 2
        
        For i = 1 To RCurrentRules
        
            While (data(POS) <> 0)
            
                RRule(i) = RRule(i) & Chr(data(POS))
                POS = POS + 1
                
            Wend
            
            POS = POS + 1
            
            While (data(POS) <> 0)
            
                RRuleValue(i) = RRuleValue(i) & Chr(data(POS))
                POS = POS + 1
                
            Wend
            
            POS = POS + 1
            
        Next
        
        Status = "E"
        
    End If
    
    If (Status = "E") Then
    
        For i = 1 To RCurrentRules
        
            If (InStr(1, RRuleValue(i), "PB") = 0) Then
            
                DerServer.PunkbusterStatus = IS_Deactivated
                
            ElseIf (InStr(1, RRuleValue(i), "REQ") <> 0) Then
            
                DerServer.PunkbusterStatus = IS_Req
                
                Exit For
                
            ElseIf (InStr(1, RRuleValue(i), "OPT") <> 0) Then
            
                DerServer.PunkbusterStatus = IS_Optional
                
                Exit For
                
            End If
            
        Next
        
        For i = 1 To RCurrentRules
        
            If (InStr(1, RRule(i), "reserve_slots") <> 0) Then
            
                DerServer.Reserved_Slots = Val(RRuleValue(i))
                
            End If
            
        Next
        
        ' Status = "no"
    End If
    
    For i = 1 To PActivePlayers
    
        If PClientName(i) <> Chr$(1) Then DerServer.Gamer(i - 1).SName = _
            PClientName(i)
            
        If PTotalfrags(i) >= 0 Then DerServer.Gamer(i - 1).SFrags = _
            PTotalfrags(i)
            
        If PGametime(i) >= 0 Then DerServer.Gamer(i - 1).STime = PGametime(i)
        
    Next
    
    For i = 1 To RCurrentRules
    
        If RRule(i) <> Chr$(1) Then DerServer.Rules(i - 1).RuleName = RRule(i)
        
        If RRuleValue(i) <> Chr$(1) Then DerServer.Rules(i - 1).RuleValue = _
            RRuleValue(i)
            
    Next
    
    ' True/False
    If LServerType <> "" Then DerServer.Dedicated = (LServerType = "d")
    ' True/False
    If LServerPassword >= 0 Then DerServer.ServerNeedPassword = _
        LServerPassword * -1
        
    ' <zb 10
    If LActiveClients >= 0 Then DerServer.ActiveClients = LActiveClients
    If LMaxClients >= 0 Then DerServer.MaxClients = LMaxClients  ' <zb 16
    If LServername <> "" Then DerServer.Servername = LServername ' <zb KGG-Cla
                                                                 ' nserver
    If LServerMap <> "" Then DerServer.ServerMap = LServerMap ' < zb cs_italy
    
    ' < zb cstrike
    If LGameDirectory <> "" Then DerServer.GameDirectory = LGameDirectory
    If LGameInfo <> "" Then DerServer.GameName = LGameInfo ' < zb
                                                           ' CounterStrike
                                                           
    DerServer.GamerCount = PActivePlayers
    DerServer.RulesCount = RCurrentRules
    
    For i = DerServer.RulesCount To UBound(DerServer.Rules)
    
        DerServer.Rules(i).RuleName = ""
        DerServer.Rules(i).RuleValue = ""
        
    Next
    
    For i = DerServer.GamerCount To UBound(DerServer.Gamer)
    
        DerServer.Gamer(i).SFrags = 0
        DerServer.Gamer(i).SName = ""
        DerServer.Gamer(i).STime = 0
        
    Next
    
End Sub

Public Function Make_Result()

    ' Server daten anzeigen
    ' Details
    If (Status = "m") Then
        If (LServername <> Trim(frmServerInfo.labServername.Caption)) Then
        
            frmServerInfo.labServername.Caption = " " & LServername
            
        End If
        
        If (LServerMap <> Trim(frmServerInfo.labMap.Caption)) Then
        
            frmServerInfo.labMap.Caption = " " & LServerMap
            
        End If
        
        If (LGameDirectory <> Trim(frmServerInfo.labGameInfo.Caption)) Then
        
            frmServerInfo.labGameInfo.Caption = " " & LGameDirectory
            
        End If
        
        If (LOperationSystem = "l") Then
        
            frmServerInfo.labOperationSystem.Caption = " Linux"
            
        Else
        
            frmServerInfo.labOperationSystem.Caption = " Windows"
            
        End If
        
        If (LServerType = "l") Then
        
            frmServerInfo.labServertype.Caption = " Listen"
            
        Else
        
            frmServerInfo.labServertype.Caption = " Dedicated"
            
        End If
        
        If (LServerPassword = 1) Then
            If (GPasswort(frmServerInfo.lstServer.ListIndex) <> "----") Then
            
                frmServerInfo.labPasswort.Caption = " " & GPasswort( _
                    frmServerInfo.lstServer.ListIndex)
                    
            Else
            
                frmServerInfo.labPasswort.Caption = " Server benötigt " & _
                    "ein Passwort"
                    
            End If
            
        Else
        
            frmServerInfo.labPasswort.Caption = " Server benötigt kein " & _
                "Passwort"
                
        End If
        
        If ("(" & PActivePlayers & ") " & LActiveClients & "/" & LMaxClients _
            <> frmServerInfo.labPlayer.Caption) Then
            
            frmServerInfo.labPlayer.Caption = "(" & PActivePlayers & _
                ") " & LActiveClients & "/" & LMaxClients
                
            frmServerInfo.labPlayerstatus.Width = 1815 / LMaxClients * _
                LActiveClients
                
            frmServerInfo.labPlayerstatus3.Width = 1815 / LMaxClients * _
                PActivePlayers
                
            If (frmServerInfo.labPlayerstatus.Width < 1815) Then
            
                frmServerInfo.labPlayerstatus2.Left = _
                    frmServerInfo.labPlayerstatus.Left + _
                    frmServerInfo.labPlayerstatus.Width
                    
                frmServerInfo.labPlayerstatus2.Width = (1815 / LMaxClients * _
                    LMaxClients) - (1815 / LMaxClients * LActiveClients)
                    
            End If
        End If
        
        If (LServername <> frmServerInfo.lstServer.List( _
            frmServerInfo.lstServer.ListIndex)) Then
            
            GServername(frmServerInfo.lstServer.ListIndex) = LServername
            
            frmServerInfo.lstServer.List(frmServerInfo.lstServer.ListIndex) _
                = GServername(frmServerInfo.lstServer.ListIndex)
                
        End If
        
        Status = "no"
        
    End If
    
    ' Players
    If (Status = "D") Then
    
        frmPlayers.lstPlayers.Clear
        
        For i = 1 To PActivePlayers
        
            frags = PTotalfrags(i)
            
            frmPlayers.lstPlayers.AddItem PClientNumber(i) & ": " & _
                PClientName(i) & " (" & frags & ")"
                
        Next
        
        minplayerid = 1
        
        For i = 1 To PActivePlayers - 1
        
            If (PTotalfrags(minplayerid) > PTotalfrags(i + 1)) Then
            
                minplayerid = i + 1
                
            End If
            
        Next
        
        maxplayerid = 1
        
        For i = 1 To PActivePlayers - 1
        
            If (PTotalfrags(maxplayerid) < PTotalfrags(i + 1)) Then
            
                maxplayerid = i + 1
                
            End If
            
        Next
        
        ' For i = 1 To PActivePlayers
        '  frmServerInfo.List1.AddItem PGametime(i)
        ' Next
        frmServerInfo.labBestPlayer.Caption = " " & PClientName(maxplayerid)
        frmServerInfo.labBestPlayerFrags.Caption = PTotalfrags(maxplayerid)
        frmServerInfo.labBadPlayer.Caption = " " & PClientName(minplayerid)
        frmServerInfo.labBadPlayerFrags.Caption = PTotalfrags(minplayerid)
        Status = "no"
        
    End If
    
    ' Rules
    If (Status = "E") Then
    
        For i = 1 To RCurrentRules
        
            If (InStr(1, RRuleValue(i), "PB") = 0) Then
            
                frmServerInfo.labPunkbuster.Caption = "DEAKTIV"
                
            ElseIf (InStr(1, RRuleValue(i), "REQ") <> 0) Then
            
                frmServerInfo.labPunkbuster.Caption = "REQUERIED"
                
                Exit For
                
            ElseIf (InStr(1, RRuleValue(i), "OPT") <> 0) Then
            
                frmServerInfo.labPunkbuster.Caption = "OPTINAL"
                
                Exit For
                
            End If
            
        Next
        
        For i = 1 To RCurrentRules
        
            If (InStr(1, RRule(i), "reserve_slots") <> 0) Then
            
                frmServerInfo.labReservedSlots.Caption = RRuleValue(i)
                
            Else
            
                frmServerInfo.labReservedSlots.Caption = 0
                
            End If
            
        Next
        
        Status = "no"
        
    End If
    
End Function

Public Sub SendDataRequest(WS As Winsock, ServerIpAndPort As String)

    ' ServerDaten abfragen
    Dim Buffer(1 To 255) As Byte
    Dim Befehl(1 To 4) As String
    Dim Trenn As Integer
    
    Trenn = InStr(1, ServerIpAndPort, ":")
    On Error Resume Next
    WS.RemoteHost = Left(ServerIpAndPort, Trenn - 1)
    WS.RemotePort = Right(ServerIpAndPort, Len(ServerIpAndPort) - Trenn)
    
    ' WS.Close
    Befehl(1) = "rules"
    Befehl(2) = "players"
    Befehl(3) = "details"
    Befehl(4) = "ping"
    
    For L = 1 To 4
        For i = 1 To 4
        
            Buffer(i) = 255
            
        Next
        
        k = 1
        
        For i = 5 To Len(Befehl(L)) + 4
        
            Buffer(i) = Asc(Mid(Befehl(L), k, 1))
            k = k + 1
            
        Next
        
        Buffer(Len(Befehl(L)) + 6) = 0
        WS.SendData Buffer
        
    Next
    
End Sub

' --------- Ende Modul "HLServer" alias HLServer.bas ---------
' -------------- Ende Projektdatei Projekt1.vbp --------------

Kommentar von Razor am 07.08.2008 um 16:03

könnte bitte jmd ne funktionierende source für CS:S coden?
bei mir funzt das nicht ... zeigt einfach nichts an

Kommentar von muetze am 21.07.2006 um 22:46

Hallo,

@Klaus Ketelaer
Ich kann den Quelltext auf http://www.rentnerserver.de leider nicht finden. Die Binary des Observer startet nicht richtig und stürzt mit einem unerwartetem Fehler ab.

Nun hätte ich an alle noch eine Frage:
Wie kann ich die empfangenen Daten am besten verwerten?
Zum testen habe ich folgenden Code:

Option Explicit


Private Sub Command1_Click()


Winsock1.Close
DoEvents
Winsock1.Protocol = sckUDPProtocol
Winsock1.RemoteHost = "192.168.1.221"
Winsock1.RemotePort = 27015
Winsock1.Connect
DoEvents
Winsock1.SendData Chr$(255) & Chr$(255) & Chr$(255) & Chr$(255) & Chr$(84) & Chr$(83) & Chr$(111) & Chr$(117) & Chr$(114) & Chr$(99) & Chr$(101) & Chr$(32) & Chr$(69) & Chr$(110) & Chr$(103) & Chr$(105) & Chr$(110) & Chr$(101) & Chr$(32) & Chr$(81) & Chr$(117) & Chr$(101) & Chr$(114) & Chr$(121) & Chr$(0)
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim Data As String


Winsock1.GetData Data
MsgBox "Remote Host : " & Data, vbInformation, "Server"

End Sub

Soweit, sogut. Was ich dabei zurückbekomme, sind diese Daten:

ÿÿÿÿItestserver

Sollte da nicht noch mehr kommen?

Grüsse,
Mütze

Kommentar von Klaus Ketelaer am 16.05.2006 um 13:12

@Christian
Hast Du eine Idee, warum das Teil HL2-Observer heißt?

Die aktuelle Versionen (incl. Source) kann man auf Rentnerserver.de herunterladen. Weitere Versionen wird es nicht geben, weil ich nur noch das HL2 Control-Center weiter entwickle. Gemeldete Fehler werden aber beseitigt.

Gruß

Klaus

Kommentar von Christian am 15.05.2006 um 23:33

Also bei funtzt der Code nicht Ich bekoimme garnichts angezeigt. @Klaus kannst du mir deine neue Version mal evtl. schicken wär das möglich? Vielleicht funtzt die ja. Hab en 1.6 Server aber dieser code oben hilft reingarnichts

Kommentar von Klaus Ketelaer am 28.03.2006 um 15:03

Bis ich weiß, wohin ich den Code dauerhaft abladen kann, habe ich mal mein Stadteil-Forum dafür zweckentfremdet.
Unter rheinkamp.com/forum/ stehen die Quellen und die Anwendung zum Download.

@YamYam
HL1 interessiert mich nicht mehr, weshalb ich dafür auch wohl keine Lösung coden werde. Shorty hat ja bereits beschrieben, worin sich die Versionen im Wesentlichen unterscheiden.

Vier Befehle austauschen und ggf. ein paar kleine Anpassungen im Parser, das sollte jeder der hier mitliest schaffen. UDP kann man ja, mangels Timeout, wunderbar debuggen;-))

Im Grunde ist aber so, daß jeder, der das Protokoll verstanden hat, die Kernfunktionen in weniger als einer Stunde schreiben kann. Daher empfehle ich nochmals:

http://valve-erc.com/srcsdk/Code/Networking/serverqueries.html

Wer sich für weitergehende Praktiken ineressiert, ist mit

http://developer.valvesoftware.com/wiki/Source_RCON_Protocol

gut beraten. Wer das verstanden hat kann auch HLSW neu coden... (Das mache ich gerade *eg*)

Kommentar von YamYam am 28.03.2006 um 13:56

"Source Engine Serverdaten auslesen" oder sowas..

Es geht hier ja nicht um CounterStrike(HL1), sondern HL2(Source Engine).

Ich bin schon sehr gespannt auf das, was Sie posten werden, Herr Ketelaer. Noch erfreuter wäre ich, wenn sie auch was für HL1 zusammenschreiben würden, damit dieser Tipp hier auch mal _aktuell_ ist.

beste Grüße,

YamYam

Kommentar von Elharter am 28.03.2006 um 13:10

Na dann mal Fragen ob du vielleicht nicht gleich einen neuen TIPP erstellen kannst.......

Tipp 0xxx: CounterStrike-Serverdaten auslesen Version 2

Kommentar von Klaus Ketelaer am 28.03.2006 um 12:57

Ich könnte den Code ja auch hier posten, wenn der Admin das zulässt...

Kommentar von Elharter am 28.03.2006 um 12:45

Naja...

du könntest mir den link mailen ^^ elharter at gmx dot at

Ich könnte mir schon vorstellen zu helfen - nur mit dem HL2CCS kenn ich mich gar ned aus...bzw. hab ich mir noch nie angesehen.

Kommentar von Klaus Ketelaer am 28.03.2006 um 12:41

@Elharter, YamYam

Der Code ist bereits neu geschrieben, und stand eine Zeit lang zum Download im Web. Leider wurde mein Beitrag, der den Link enthielt, hier nicht veröffentlicht.

Werde den Code mal bei Planet-Source einstellen... (Hätte ich längst gemacht, wenn mein Englisch nicht so grottig wäre)

Zur Zeit arbeite ich an einem HL2 Control-Center, welches aus Klassen und Controls besteht, mit denen sich jeder eine komplette Administrations-Oberfläche für HL2 zusammenklicken kann. Bisher werden _alle_ Daten geliefert, Mapwechsel, Kicken, Bannen, etc. wird ebenfalls unterstützt. Zudem gibt es eine Console, mit der alles möglich ist, was RCon so hergibt.

Die Controls, samt Beispielanwendung in VB könnte ich ebenfalls mal veröffentlichen.

Zudem suche ich VBler, die Lust hätten, eine Anwendung auf Basis der HL2CCS (HL2 Console-Construction-Set) zu schreiben, und helfen, die Library schußfest zu machen.

Kommentar von Elharter am 28.03.2006 um 12:15

glaubst???? Na dann ^^

Kommentar von YamYam am 28.03.2006 um 12:01

Klaus Ketelaer macht es in 1-2 Stunden.

Kommentar von Elharter am 28.03.2006 um 11:50

naja...wer sollte sich die Mühe machen.

Ist ja kein Klacks...außerdem müssten da schon mehr Leute mithelfen.

Kommentar von YamYam am 28.03.2006 um 11:19

Hallo,

wie wär's, wenn jemand (wie z.b. Klaus Ketelaer) den kompletten Code neu schreibt? Und zwar funktionierend! Für HL1+Mods und HL2+Mods.

Weil hier ist alles sehr veraltet und zusammengeschustert!


Mfg don

Kommentar von Elharter am 03.03.2006 um 12:54

@Klaus Ketlaer

Könntest du mir ein wenig behilflich sein bei der Umsetzung dieses Projekts....arbeite in Vb.NET!

Wäre über Hilfe sehr dankbar!
Meld dich bei mir, per Mail wenn du helfen kannst/willst.
lg

Kommentar von Klaus Ketelaer am 28.02.2006 um 11:25

@Tobias
Ich habe die Aufbereitung der Spielerzeit kritisiert und einen einwandfreien Ersatzcode gepostet. Schade, daß Du die Tragweite des Codes nicht verstanden hast. Das Casten von Daten ist von elementarer Bedeutung.

Zudem lobst Du Shorty, weil er dieses "Programm" pflegt. Ich dagegen bin der Meinung, daß er der VB-Welt damit keinen Gefallen tut. Beispielcode sollte einen richtigen Ansatz verfolgen, und halbwegs solide programmiert sein. Das, was Shorty da pflegt, ist im Ursprung bereits mäßig umgesetzt und schlecht programmiert.

Jeder, der vernünftig programmieren kann, schreibt (anhand der Anleitung unter http://www.valve-erc.com/srcsdk/Code/Networking/serverqueries.html) innerhalb
von 1-2 Stunden den gesamten Code "sauber" neu. Zumindest habe ich so lange für eine HL2-Lösung gebraucht...

Kommentar von Tobias am 28.02.2006 um 08:38

Ich dachte immer der Sinn und Zweck eines solchen Forums/Website ist sich gegenseitig weiterzuhelfen und zu ergänzen und nicht um andere anzupöbeln.

Zuerst einmal ein dickes Lob an Shorty, der den schon etwas älteren Source Code (siehe oben) weiter gepflegt hat und einem dank seiner Weiterentwicklung ein funktionierendes Sample liefern kann. Weiter so Shorty.

Andere hingegen posten nur ein paar Funktionen ohne genauere Beschreibung oder Erläuterungen. So ist wohl keinem weitergeholfen.

Kommentar von shorty am 26.02.2006 um 13:20

Es gibt viele Wege nach Rom...
Bin noch ziemlicher VB Anfänger und froh dass es überhaupt funzt.

Für bessere Lösungen bin ich immer zu haben.
Man lernt ja nie aus...

;-)

Kommentar von Klaus Ketelaer am 26.02.2006 um 12:59

@Shorty

Dein Code ist eine reine Katastrophe!

Damit Du mal siehst, wie man das so halbwegs richtig macht, poste ich mal eine Funktion, um die Zeit zu berechnen, und eine Weitere, um die Zeit formatiert auszugeben:


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)


Public Function MakeTime(ByVal szTerm As String) As Single
Dim sValue As Single
Dim B(0 To 3) As Byte

On Error GoTo Fehler
If Len(szTerm) = 4 Then
B(0) = Asc(Mid$(szTerm, 1, 1))
B(1) = Asc(Mid$(szTerm, 2, 1))
B(2) = Asc(Mid$(szTerm, 3, 1))
B(3) = Asc(Mid$(szTerm, 4, 1))

CopyMemory sValue, B(0), 4
Else
Debug.Assert 1 = 2
End If

MakeTime = sValue
On Error GoTo 0
Exit Function

Fehler:
MakeTime = -1
End Function

Public Function MakeTimeString(ByVal sTime As Single) As String
Dim lHours As Long
Dim lMinutes As Long
Dim lSeconds As Long

On Error GoTo Fehler
lHours = sTime \ 3600
sTime = sTime Mod 3600

lMinutes = sTime \ 60
lSeconds = sTime Mod 60

MakeTimeString = TimeSerial(lHours, lMinutes, lSeconds)
On Error GoTo 0
Exit Function

Fehler:
MakeTimeString = "EE"
End Function

Kommentar von Shorty am 18.01.2006 um 00:58

Nicht direkt... die Source Engine liefert etwas andere Daten, das Prinzip ist aber gleich.
Hab was, das schick ich dir wenn ich Zeit hab.

MfG

Kommentar von Tobias am 17.01.2006 um 20:42

Hallo, heißt das das sample für Source nicht zu gebrauchen ist? Auch nicht mit den unten aufgeführten Änderungen.

Hat jemand ne funktionierende Version mit welcher ich einen Source Server auslesen kann?

Wenn ja nach Möglichkeit bitte mailen: MasterChild(AT)gmx(DOT)de

Kommentar von Shorty am 29.10.2005 um 19:58

Klar, kann man. siehe: DerServer.Gamer(i).sFrags

dieser Source ist aber überholt und läuft seit einem
HL-Engine Update nicht mehr. (siehe Kommentare weiter unten).

mfg

Kommentar von Johannes Franz am 29.10.2005 um 15:24

Voll toll aber kann man mit diesem Sorce auch die Frags auslesen?

Kommentar von Shorty am 25.10.2005 um 19:05

Natürlich nicht... nur mit RCON Passwort möglich.

Shorty

Kommentar von HaXX0rZ am 25.10.2005 um 13:42

kann man damit auch server passwörter rausfinden? (nich OB sie welche haben!)

Kommentar von Shorty am 28.08.2005 um 14:47

Klar, ich stell was zusammen wenn ich Zeit hab.

mfg

Shorty

Kommentar von Xium am 28.08.2005 um 12:32

Nachtrag: olli165(at)gmx(dot)net

Kommentar von Xium am 28.08.2005 um 11:17

Hi Shorty,

wärst du so lieb und schickst mir auch deine aktuelle Version? Ist ja schon ziemlich veraltet das Ding.

mfg
Xium

Kommentar von Shorty am 10.08.2005 um 13:12

Das hat mit dem neuen Protokoll zu tun.

Als erstes musst du an den Server senden:

Public Sub SendRconNr(WS As Winsock, IP As String, Port As String)
With WS
    .RemoteHost = IP
    .RemotePort = Port
    
    .SendData Chr(255) & Chr(255) & Chr(255) & Chr(255) & Chr(&H57) '"W"
    
End With
End Sub

damit bekommst du als Antwort eine Nummer in dem Format:

Header (FF FF FF FF)
Byte ("A")
Long (4Byte Challenge Nummer)

die du an die Player und Rules Anfrage anhängen musst.

Die Anfragen lauten dann:

Public Sub SendInfoStr(WS As Winsock, IP As String, Port As String, Rcon As Long, RconStr() As Variant)
With WS
    .RemoteHost = IP
    .RemotePort = Port
    
    .SendData Chr(255) & Chr(255) & Chr(255) & Chr(255) & Chr(&H54) & "Source Engine Query"
End With
End Sub
Public Sub SendPlayer(WS As Winsock, IP As String, Port As String, Rcon As Long, RconStr() As Variant)
With WS
    .RemoteHost = IP
    .RemotePort = Port
    
    .SendData Chr(255) & Chr(255) & Chr(255) & Chr(255) & Chr(&H55) & Chr(RconStr(1)) & Chr(RconStr(2)) & Chr(RconStr(3)) & Chr(RconStr(4))
End With

End Sub
Public Sub SendRules(WS As Winsock, IP As String, Port As String, Rcon As Long, RconStr() As Variant)
With WS
    .RemoteHost = IP
    .RemotePort = Port
    
    .SendData Chr(255) & Chr(255) & Chr(255) & Chr(255) & Chr(&H56) & Chr(RconStr(1)) & Chr(RconStr(2)) & Chr(RconStr(3)) & Chr(RconStr(4))
End With
End Sub

hoffe das hilft dir weiter.

Eine andere Möglichkeit für HL1 Server (CS 1.6):
Den Server mit

sv_enableoldqueries 1

auf das alte Protokoll umstellen.
Dann ist die Challenge Nummer überflüssig.

mfg

Shorty

Kommentar von potze am 13.07.2005 um 09:21

Hallöchen..
Ich habe das ganze mal in Java (mit dem Source Query Protokoll) geschrieben, allerdings habe ich den Effekt, dass ich manchmal von einigen Servern, wenn ich die Namen, Frags usw. der Spieler zuschicken lassen will, nur den Header + 0 bytes bekomme, obwohl Spieler auf dem Server sind... Die Settings kann ich mir dennoch ohne Probleme jederzeit anzeigen lassen.. Hat jemand hier ähnliche Erfahrungen gemacht?

Kommentar von Elharter am 12.07.2005 um 12:49

HEy,

komme gar nicht zurecht mit dem beispiel hier, habe VB.NET und bekomme als fehlermeldung das die Lizenz von Winsock abgelaufen sein soll......

habe auch gelesen das man bei vb.net statt winsock mit dem beiliegendem SystemTCP Listener arbeiten sollte.

Kann mir wer helfen?

wenn ja bitte antwort an: elharter at gmx dot at

Kommentar von Shorty am 18.06.2005 um 13:21

Wenn du im Sub "SendDataRequest" die Einträge

Befehl(1) = "rules"
Befehl(2) = "players"
Befehl(3) = "details"

änderst in:

Befehl(1) = "V"
Befehl(2) = "U"
Befehl(3) = "T"

sollte es wieder funktionieren.

mfg

Shorty

Kommentar von Narfik am 15.06.2005 um 13:36

Seit dem neuen Protokoll geht die alte Serverabfrage nicht mehr. Die HL 1 Engine nutzt jetz das Source Query Protokoll welches leicht abgeändert ist. Kann mal jemand das Beispiel hier umcoden?
http://www.valve-erc.com/srcsdk/Code/Networking/serverqueries.html

Kommentar von Narfik am 15.06.2005 um 13:36

Seit dem neuen Protokoll geht die alte Serverabfrage nicht mehr. Die HL 1 Engine nutzt jetz das Source Query Protokoll welches leicht abgeändert ist. Kann mal jemand das Beispiel hier umcoden?

Kommentar von Shorty am 09.05.2005 um 20:34

Hab dir mein Modul geschickt mit Beschreibung.
Hab einiges zum obigen Code geändert, läuft aber
bei mir seit dem stabil

mfg

Kommentar von Tremor am 09.05.2005 um 20:00

Also in die Prozedur "SetServerData" und in die Prozedur, in der die Serverdaten ausgelesen und ausgegeben werden (falls nicht anders abgefangen):

Direkt unter den Prozeduraufruf:

<script>
Public Sub SetServerData(data)
On Error GoTo ErrorHandle
</script>

und nach ganz unten direkt über "End Sub" folgendes:

<script>
Exit Sub

ErrorHandle:
Debug.Print "DATA Range: ( " & UBound(data) & " ) @ " & Now
Debug.Print "ErrorHandle in SetServerData: " & Error$(Err)
Err.Clear
Exit_SetServerData:

End Sub
</script>

Nicht schön, aber funzt wenigstens einwandfrei. Wenn der Server in kurzen Abständen ausgelesen wird, fällt mal ein Ausfall nicht auf.

Kommentar von Tremor am 07.05.2005 um 11:32

Hallo Shorty,

gerne ;)
tremor(at)mashina(dot)de
Sorry wg. Spamschutz :)

Hast du dir den Inhalt der Pakete komplett selbst analysiert, oder gibt es einen link oder andere Quelle, der/die mir das auch *etwas* näher bringen kann?

Ich versuche eine Regel zu finden, nach der die Auswertung erst gar nicht erfolgen sollte.

best regards
Tremor

Kommentar von Shorty am 07.05.2005 um 10:55

An diesem Problem hab ich lang gebrütet und auch keine saubere Lösung hinbekommen.
Ich denke es hängt auch mit unglücklichen Umständen und der
Performance des Servers zusammen.
In den Multipaketen gibt es noch einige Bits, über deren Funktion ich mir noch nicht
so richtig im klaren bin.
Könnten natürlich damit was zu tun haben,
hab aber noch keine Beschreibung darüber gefunden.

Ich kann dir mal mein komplettes Modul zur Auswertung schicken.
Poste mal deine email.

mfg

Shorty

Kommentar von Tremor am 06.05.2005 um 21:26

Danke Shorty,

on error resume next habe ich ausgiebig in Verwendung, doch leider ist der Code mittlerweile reines Flickwerk. Eine Stelle ist gestopft, eine andere Fehlermeldung taucht auf. Nachdem ich Array-Überläufe mit dem Errorhandling doch zunehmend abfange hängt sich die Anwendung jetzt dafür öfter mal auf.

Kann man nicht von Anfang an klären, ob die Daten überhaupt komplett vorhanden sin, bevor diese ausgewertet werden? Oder gibt es eine andere weitere Möglichkeit das ganze Wartungsfrei zu bekommen?

Für Vorschläge immer offen ;)

Kommentar von Shorty am 30.04.2005 um 10:35

Hi Tremor,

hatte ich auch ab und zu, habs einfach mit einem

On Error Resume Next
      '...dein Code mit dem Fehler
On Error Goto 0

gelöst.

Ist zwar nicht die feinste Art, aber funktioniert.

mfg

Shorty

Kommentar von Tremor am 29.04.2005 um 21:13

Ich bekomme leider unter XP/VB6 nach einiger Zeit die Meldung
data(POS) <Subscript out of range>
Error '9'

z.B. an dieser Stelle (letzte Sichtung):

While (data(POS) <> 0)
RRuleValue(i) = RRuleValue(i) & Chr(data(POS))
POS = POS + 1
Wend

aber nicht ausschliesslich.

Nach einen Neustart läuft dann wieder alles Rund. Wie kann ich den Fehler abfangen?

Kommentar von Shorty am 22.03.2005 um 14:08

Hi Don,

ist unterwegs.

Kommentar von don am 21.03.2005 um 15:22

donmagic@gmx.de

super nett von dir!

Kommentar von Shorty am 20.03.2005 um 20:03

Klar, schreib dir mal was zusammen.

deine email?

meine ist shorty@prostjumsen.de

mfg

Shorty

Kommentar von don am 20.03.2005 um 16:49

Hallo Shorty,

irgendwie will's bei mir trotzdem nicht funktionieren, könntest du mir ein funktionierenden projekt schicken? vielleicht sogar mir formular (listbox), wo die rules din stehen. vielleicht kann ichs dann besser nachvollziehen

mfg don

Kommentar von am 20.03.2005 um 11:11

Vergessen... hier

Public RTimer(1 To 2) As Variant

mfg

Kommentar von don am 19.03.2005 um 21:02

Hi Shorty, danke schonmal an dich!

Aber ich glaube du hast etwas vergessen, die funktion RTimer() ist nicht definiert.

mfg don

Kommentar von Shorty am 19.03.2005 um 18:06

Hi,

diesen Code nach den Rules
[code}
' Rules einlesen
[/code]
einfügen. Der originale Code liesst die Rules bei einem Paket, dieser bei 2 Paketen (je nachdem wieviel Rules
der Server sendet.

Hoffe ich hab nix vergessen... ;)

Dim RServerPacket As String
Dim RPacketCounter As Integer

'Rules
If RPacketCounter = 3 Then RServerPacket = ""
If RPacketCounter = 3 Then RPacketCounter = 0

'Pointer initalisieren
POS = 0

' Rules bei 2 Paketen auslesen
If (CSng(data(POS)) = 254) And (CSng(data(POS + 1)) = 255) Then
    
    POS = 8     ' 1. oder 2. Packet?
    If CSng(data(POS)) = 2 Then RPacketCounter = 1
    If CSng(data(POS)) = 18 Then RPacketCounter = 2
    ' 1. Packet speichern
    If RPacketCounter = 1 Then
        POS = 4
        RTimer(RPacketCounter) = (CSng(data(POS)) + (CSng(data(POS + 1)) * 256) + (CSng(data(POS + 2)) + 65536) * (CSng(data(POS + 3)) + 16777216)) / 3600
        POS = 14
        RCurrentRules = data(POS) + data(POS + 1)
        POS = POS + 2
        For r = POS To bytestotal - 1
            On Error Resume Next
            RServerPacket = RServerPacket & Chr(data(r))
        Next r
        On Error Goto 0
    End If
    ' 2. Packet zum 1. hinzufügen
    If RPacketCounter = 2 Then
        POS = 4
        RTimer(RPacketCounter) = (CSng(data(POS)) + (CSng(data(POS + 1)) * 256) + (CSng(data(POS + 2)) + 65536) * (CSng(data(POS + 3)) + 16777216)) / 3600
            If RTimer(1) <> RTimer(2) Then Exit Sub ' 1. Packet zum 2. Packet ?
        POS = 9
        For r = POS To bytestotal - 1
            On Error Resume Next
            RServerPacket = RServerPacket & Chr(data(r))
        Next r
        On Error Goto 0
        'Debug.Print RServerPacket
        RPacketCounter = 3
    End If
    ' wenn beide Packete da, Rules auslesen und Arrays zuweisen
    If RPacketCounter = 3 Then
    POS = 1
    For i = 1 To RCurrentRules
        RRule(i) = ""
      While (Mid(RServerPacket, POS, 1) <> Chr(0))
        RRule(i) = RRule(i) & Mid(RServerPacket, POS, 1)
        POS = POS + 1
      Wend
      POS = POS + 1
      RRuleValue(i) = ""
      While (Mid(RServerPacket, POS, 1) <> Chr(0))
        RRuleValue(i) = RRuleValue(i) & Mid(RServerPacket, POS, 1)
        POS = POS + 1
      Wend
      'Debug.Print RRule(i) & "  " & RRuleValue(i)
      POS = POS + 1
    Next
    Status = "E"
    End If
End If

mfg

Shorty (shorty@prostjumsen.de)

Kommentar von don am 19.03.2005 um 11:13

bitte die Lösung für die Rules posten :/

Kommentar von Shorty am 15.02.2005 um 20:58

Hab die Lösung für die Player-Online Zeit:

Diese Zeilen

Dim PGametime(1 To 128) As Single
...
PGametime(i) = -1
...
      PGametime(i) = CSng(data(POS) & data(POS + 1) & data(POS + 2) &  _
      data(pos4))
...
  If PGametime(i) >= 0 Then DerServer.Gamer(i - 1).STime = PGametime(i)

mit diesen ersetzen:

Dim PGametime(1 To 128) As String
...
PGametime(i) = ""
...
      Dim Time0 As String
      Dim Time(0 To 3) As Byte
      ' Bytes in Array laden und umrechnen
      For m = 0 To 3
        Time(m) = data(POS + m)
      Next m
      PGametime(i) = BytesToTime(Time())
...
  If PGametime(i) <> "" Then DerServer.Gamer(i - 1).STime = PGametime(i)

Und diesen Code hinzufügen (wandelt das Byte-Array um):

Public Function BytesToTime(ByRef bytes() As Byte) As String
    Dim sign As Integer, exponent As Byte, mantissa As Long
    Dim TimeDez, TimeStd, TimeMin, TimeSek As Variant
    Dim TimeStdStr, TimeMinStr, TimeSekStr As String
    Dim Zaehler As Integer
' Bytes decodieren
    Let sign = IIf(bytes(3) \ 128, -1, 1)
    Let exponent = (2 * (bytes(3) And 127) + bytes(2) \ 128)
    Let mantissa = (bytes(2) Or 128) * 65536 _
                + bytes(1) * 256& _
                + bytes(0)
    Let TimeDez = (sign * mantissa * 2 ^ (exponent - 150)) / 60
' TimeDez hat Format: "Min,Sek(Dezimal)" z.b. "2,5" entspricht "2:30"
    
    Zaehler = InStr(TimeDez, ",")
    TimeMin = Left(TimeDez, Zaehler - 1)

' Stunden und Minuten berechnen
    If TimeMin > 59 Then
        TimeStd = Round(TimeMin / 60, 0)
        TimeMin = TimeMin - (TimeStd * 60)
    End If

' Sekunden berechnen
    If Mid(Time0, Zaehler + 1, 1) = 0 Then
        TimeSek = Round((Mid(TimeDez, Zaehler + 2, 1)) * 0.6, 0)
    Else
        TimeSek = Round(Mid(TimeDez, Zaehler + 1, 2) * 0.6, 0)
    End If

' Std, Min u. Sek auf 2 Stellen formatieren
    TimeSekStr = TimeSek
    If TimeSek < 10 Then TimeSekStr = "0" & TimeSek
      
    TimeMinStr = TimeMin
    If TimeMin < 10 Then TimeMinStr = "0" & TimeMin
    If TimeMin < 1 Then TimeMinStr = "00"
      
    TimeStdStr = TimeStd
    If TimeStd < 10 Then TimeStdStr = "0" & TimeStd
    If TimeStd < 1 Then TimeStdStr = "00"

' String zusammensetzen in der Form "Std:Min:Sek", also z.b. "01:04:45"
    Let BytesToTime = TimeStdStr & ":" & TimeMinStr & ":" & TimeSekStr
End Function

Es wird die richtige Zeit in der Form "Std:Min:Sek" zurückgegeben.
Also z.b. "01:02:45"

Könnte man vielleicht auch kürzer machen, aber ich bin noch ein
VB-Anfänger und froh, dass es überhaupt funktioniert... ;)

Bei mir wird jetzt die Zeit richtig angezeigt.

An einer Lösung für die Rules bin ich auch noch. Wird natürlich gepostet
wenn ich eine Lösung habe.
Soviel hab ich schon herausgefunden, das Format des vom Server geschickten Paketes ist anders.
Bei meinem Server kommen sogar 2...

mfg

Shorty

Kommentar von Shorty am 12.02.2005 um 16:26

Schon jemand ne Lösung für das auslesen der Rules?

mfg

Shorty

Kommentar von Tobias am 08.02.2005 um 08:55

Funktioniert nur unter CS:Source nicht vollständig. Jemand schon ne Idee, Lösung?

mfg

Tobias

Kommentar von Shorty am 30.01.2005 um 03:34

Ganz nett, aber weis jemand wie man Befehle an einen Server (rcon) schickt?

Adminrechte natürlich vorausgesetzt... ;)

mfg

Shorty

Kommentar von Michael am 10.01.2005 um 22:14

Ich kann die ServerRules nicht auslesen, hat einer eine Idee wie das funktioniert? (Bin Anfänger, wäre dankbar für verständliche Antwort oder Beispiel)

Danke im vorraus.

Kommentar von Michael Handschuh am 15.06.2004 um 23:59

Hi leute
Super Tool. Hat aber leider einige nicht sehr schöne Fehler.
Zum Beispiel das Auslesen der Player geht nicht so richtig, konnte ich aber mit meinen Programmierkenntnissen fixen.
Die Rules werden leider bei mir noch immer nicht ausgelesn, aber auch da bin ich an einer Lösung.

Was mich aber wirklich interessiert ist:
In was fürnem Format ist die Zeit gespeichert ???
es sind keine 1000stel sekunden oder was....
chek das ding echt net :(

Die Zahl is irgendwie viel zu hoch....

xxxxx.xxxxxx+E9

PLZ Help Me

Kommentar von Snake am 15.04.2004 um 22:29

Hi Sebastian

So sende ich die Daten an den Server:
HLServer.SendDataRequest Winsock1, cb_Server.Text
(Wenn der Befehl mehrfach aufgerufen wird, kommt eine Fehlermeldung und das Programm beendet sich. Wenn ich es in der IDE-Umgebung laufen lasse, markiert er mir nach mehrfachen Aufrufen verschiedene Codestellen in dem Modul.)

Danach lasse ich sie in der Winsock1_DataArrival-Prozedur anzeigen.
(Hier sind keine Fehler.)

Mfg Snake

Kommentar von Silver am 31.03.2004 um 22:20

Hi Sebastain,
hab meinen fehler jetzt endlich gefunden, dank dir ;)
du hast mich darauf aufmerksam gemacht das ich meine daten über das modul auslesen muss...
ich habs immer über die form mit

DerServer.Gamer(i).SName

so ist irgendwie der erste spieler verloren gegangen...
jetzt gehts ja endlich ;) juhu

Kommentar von Sebastian am 30.03.2004 um 18:16

hi, wann genau fragst du das modul ab?

es weden 3-4 befehle gesendet und du musst die spielerdaten dann auslesen, wenn diese angefragtwurden, bitte drauf achten

wann genau fragst du die daten ab, bei welchen ereignis?

Kommentar von Silver am 30.03.2004 um 17:04

hmm...scheint wohl doch nicht an sonderzeichen zu liegen, es fehlt meinstens der erste Player der übertragen wird

Bitte um Hilfe! bin im moment echt ratlos

Kommentar von Silver am 30.03.2004 um 15:13

Hilfe!!
hab bei manchen spielernamen einfach einen leeren eintrag, der name fehlt irgendwie (auch seine anderen daten wie points und time)
der spieler scheint irgendwo verloren zu gehen, denn in der "data"-datei ist es zu finden...
kann den fehler einfach nicht finden, scheint evt. etwas mit sonderzeichen wie $ zu tun zu haben, kann aber nicht genau sagen woran es liegt.

Kommentar von Sebastian am 19.03.2004 um 23:56

hat jemand ne ahnung wie man die zeit HLServer.DerServer.Gamer(i).STime in was lesbares konvertiert?

bim im moment mit meinem latain am ende

THX

Kommentar von FanatiX am 02.02.2004 um 21:46

achneee so geht das:

For i = 1 To DerServer.ActiveClients
    List1.AddItem Replace(DerServer.Gamer(i).SName, "
", "")
Next i

so dann bekommt man ne liste mit allen spielern, ohne das zeichen am anfang vom nick: "
"
so iss das auch bei den anderen funktionen, man muss nen index angeben *hmpf*
also an alle dies ned hinbekommen, iss ganz easy wie ihr seht ;)

Kommentar von FanatiX am 02.02.2004 um 21:25

bei mir will das teil auch ned wirklich die gamersachen auslesen, da kommt dann immer *Gamer wird markiert* ungültiger bezeichner...
kann da mal jmd nachhaken? ich bin mit meinem latein am ende

Kommentar von Snake am 14.12.2003 um 21:01

Genau so was habe ich gesucht ;-)

Ein Problem gibt es aber:
Mit der Zeit erscheinen bei mehrfachem Aufruf Fehlermeldungen:
--------------------------------------
Laufzeitfehler "9"
Index außerhalb des gültigen Bereichs
--------------------------------------
Die Fehler kommen an verschiedenen Stellen im Code.

Kann das jemand beheben?

Mfg Snake

Kommentar von arcanon am 28.07.2003 um 10:55

tag auch :)
für cs funzt das ding ja wunderbar, aber weis jemand wo ich sowas für quake 3 finde? ich such jetzt schon den ganzen vormittag dannach per google & co, find aber nicht wirklich was! php basierte lösung würde auch gehen, thx....

arc

ps: mit quake ip's und ports will das zeug nie :((

Kommentar von Marc Gistel am 09.07.2003 um 14:14

Ich hab auch ein Prob. ich starte die .exe von dem Projekt und geb die IP von nem Server an und drück auf "get data", aber da kommt bei mir nix, keine Daten des Servers werden angegeben

Ich hoffe ihr könnt mir helfen, kann man da auch das Passwort des Servers ermitteln ?

Und noch für die CS Spezialisten, wenn ihr Probleme mit cs habt, ihr könnt mir mailen unter marc@gistel.de oder mir per msn massenger schreiben unter marc_gistel@hotmail.com.



bitte helft mir !!!!!!

Kommentar von M@xximizer am 22.06.2003 um 19:41

Kommentar zu den super CS-Zockern:
Dies ist eine Fachseite zu Programmierung, dies ist ein Beispiel zum auslesen der CS-Serverdaten mit Visual Basic!
Und kein CounterStrike-Forum!

Kommentar von master_cetin am 31.05.2003 um 01:12

ich habe da ein prob mein cs ladet nicht die client.dll datei

Kommentar von Aliet am 19.02.2003 um 14:30

und ich habe noch ein problem.Problem über problem wenn ich die console öffnen will dann kommt das er die client.dll nicht laden kann

Kommentar von Aliet am 19.02.2003 um 14:22

Ich hätte da mal eine frage ich habe mir die deutsche half-life version gekauft,jetzt kommt mein problem wenn ich play onlne aufrufe kommt ich hätte nicht die neuste version obwohl ich 1.5 habe und dan wenn ich versuche zu join dann kommt das ich eine andere protokol version habe und ich suche die neue woncomm.1st datei

Kommentar von hamZta am 25.01.2003 um 09:59

Nettes beispiel
will nur wissen wie mand en ping vom server empfängt!!!

Kommentar von Sve´n am 02.01.2003 um 22:34

Wenn ich das mach zeigt er nur den Namen vom Server an, wie kann ich da noch den Rest auslesen, ich kenn mich mit Modulen net aus!?!

Bye

Kommentar von GoWa am 24.12.2002 um 05:46

Nettes Teil.
Hat einer von euch eine Ahnung wie ich ein Programm schreiben kann mit dem ich die Console von CS abprüfen kann ?
Also das ich ein eigenes Kommando einbaue:
meinkürzel start_etwas
meinkürzel mach_etwas
meinkürzel status = 10
Das muß, soweit ich das bisher gesehen habe auch ohne eine eigene Client dll gehen. Wäre cool wenn einer der eine Ahnung hat wie das geht oder gehen könnte mir bescheidt gibt.

Kommentar von MeisterM am 11.12.2002 um 16:12

Bei mir funktioniert alles bis auf das auslesen der Spieler und der Rules.

@ Black Angel:
Wenn du das machen willst hol dir einfach HLSW

2. Timeleft steht in den Rules

3. Counterstrike kannst du mit Shell starten

4. Dann musst du halt machen dass er die Ip überprüft und sobalt sie gültig ist connectet

Kommentar von Black Angel am 24.10.2002 um 13:21

Ist ja richtig Cool das Beispiel. Kann mir jemand sagen wie ich damit "Timeleft" ermitteln kann und wie ich Counterstrike starten kann und gleich mit dem eingegebenen Server connected.