Sockudp + TCL + Windrop

Nu ved jeg ikke hvad TCL eller sockudp er, men da du spørger i Visual Basic kategorien så går jeg ud fra det har noget med vb at gøre ?, jeg kan godt hjælpe dig med at lave et program i vb der kan hente de informationer

har du msn eller kan du findes på irc?

det ville virkelig være fedt..

msn: lgsupermand@hotmail.com

Option Explicit
Dim strVars() As String
Dim colPlayers As Collection

Private Sub Form_Load()
    On Error GoTo handle
   
    Dim strTemp As String
   
    If Command = "" Then
        Err.Raise 60000
    Else
        strTemp = BeforeFirst(Command, " ")
        If strTemp = "" Then
            Err.Raise 60000
        Else
            Winsock.RemoteHost = strTemp
        End If

        strTemp = AfterFirst(Command, " ")
        If strTemp = "" Then
            Err.Raise 60000
        Else
            Winsock.RemotePort = strTemp
        End If
    End If
   
'    Winsock.RemoteHost = "193.163.220.190"
'    Winsock.RemotePort = 27974

    Winsock.SendData "ÿÿÿÿgetstatus"

    Exit Sub
handle:
    Select Case Err.Number
        Case 60000
            MsgBox "Invalid input, most be: quake3info.exe <server_ip> <server_port>", vbCritical, "Invalid input"
        Case Else
            Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End Select
   
    Unload Me
End Sub

Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Winsock.GetData strData
   
    ParseResult strData
End Sub

Private Sub ParseResult(strResult As String)
    Dim intPos As Integer
    Dim strTemp As String
   
    'fjerner ÿÿÿÿstatusResponse og chr(10)
    strResult = Mid(strResult, 21)
   
    'finder ud af hvor player navnene begynder
    intPos = InStr(1, strResult, Chr(10))
   
    'Udtrækker indstillingerne
    strTemp = Left(strResult, intPos - 1)
   
    'Parser server indstillingerne
    ParseVars strTemp
   
    'Finder players
    ParsePlayers Mid(strResult, intPos + 1)
   
    Select Case GetVar("gamename")
        Case "osp"
            'Så skal players sættes på hold
            'Players_Red
            Asignteam GetVar("Players_Red"), "Red"
            'Players_Blue
            Asignteam GetVar("Players_Blue"), "Blue"
           
        Case "arena"
       
    End Select
   
    SortPlayers
   
    WriteDoc
End Sub

Private Sub ParseVars(strSettings As String)
    Dim intPos As Integer, intTemp As Integer, intSize As Integer, i As Integer
    Dim blnValue As Boolean
    Dim strTemp As String, strName As String
    Dim ting As Variant
   
    ReDim strVars(2, 0)
   
    Do
        intTemp = InStr(intPos + 1, strSettings, "\")
        If intTemp <> 0 Then
            strTemp = Mid(strSettings, intPos + 1, intTemp - intPos - 1)
        Else
            strTemp = Mid(strSettings, intPos + 1)
        End If
       
        If blnValue Then
            intSize = UBound(strVars, 2) + 1
            ReDim Preserve strVars(2, intSize)
           
            strVars(0, intSize) = strName
            strVars(1, intSize) = strTemp
            blnValue = False
        Else
            strName = strTemp
            blnValue = True
        End If
       
        intPos = intTemp
    Loop While intPos <> 0
End Sub

Private Sub ParsePlayers(strPlayers As String)
    Dim intTemp As Integer, intPos As Integer, intFrags As Integer, intPing As Integer, intNumber As Integer
    Dim strTemp As String, strName As String
    Dim objPlayer As clsPlayer
   
    Set colPlayers = New Collection
   
    strPlayers = Replace(strPlayers, Chr(34), "")
    If Left(strPlayers, 1) = Chr(10) Then
        strPlayers = Right(strPlayers, Len(strPlayers) - 1)
    End If
    If Right(strPlayers, 1) = Chr(10) Then
        strPlayers = Left(strPlayers, Len(strPlayers) - 1)
    End If
   
    Do
        intNumber = intNumber + 1
        intTemp = InStr(intPos + 1, strPlayers, Chr(10))
        If intTemp <> 0 Then
            strTemp = Mid(strPlayers, intPos + 1, intTemp - intPos - 1)
        Else
            strTemp = Mid(strPlayers, intPos + 1)
        End If
       
        If strTemp = "" Then Exit Do
       
        intFrags = BeforeFirst(strTemp, " ")
        strTemp = AfterFirst(strTemp, " ")
        intPing = BeforeFirst(strTemp, " ")
        strName = AfterFirst(strTemp, " ")
       
        Set objPlayer = New clsPlayer
        objPlayer.Frags = intFrags
        objPlayer.Ping = intPing
        objPlayer.Name = strName
        objPlayer.Number = intNumber
       
        colPlayers.Add objPlayer, objPlayer.Name
       
        intPos = intTemp
    Loop While intPos <> 0
End Sub

Public Function GetVar(strName As String) As String
    Dim i As Integer
    For i = 1 To UBound(strVars, 2)
        If strVars(0, i) = strName Then
            GetVar = strVars(1, i)
        End If
    Next
End Function

Private Sub Asignteam(strNumbers As String, strTeamName As String)
    Dim strTemp As String
    Dim objPlayer As clsPlayer
   
    Do While strNumbers <> ""
        strTemp = BeforeFirst(strNumbers, " ")
        strNumbers = AfterFirst(strNumbers, " ")
       
        For Each objPlayer In colPlayers
            If objPlayer.Number = strTemp Then
                objPlayer.Team = strTeamName
                Exit For
            End If
        Next objPlayer
    Loop
End Sub
Private Sub SortPlayers()
    Dim i As Integer, j As Integer
    Dim objPlayer As clsPlayer
    Dim col As New Collection
    Dim blnPlaced As Boolean
   
   
    For i = 1 To colPlayers.Count
        blnPlaced = False
       
        For j = 1 To col.Count
            If colPlayers(i).Frags > col(j).Frags Then
                col.Add colPlayers(i), colPlayers(i).Name, j
                blnPlaced = True
                Exit For
            End If
        Next j
        If blnPlaced = False Then
            col.Add colPlayers(i), colPlayers(i).Name
        End If
    Next i
   
    Set colPlayers = col
End Sub

Public Sub WriteDoc()
    Dim doc As New DOMDocument
    Dim root As IXMLDOMElement
    Dim element As IXMLDOMElement, subelement As IXMLDOMElement, e As IXMLDOMElement
    Dim node As IXMLDOMNode
    Dim objPlayer As clsPlayer
   
    Set root = doc.createElement("server")
    doc.appendChild root
   
    Set element = doc.createElement("refreshed")
    root.appendChild element
   
    Set node = doc.createTextNode(Format(Now(), "hh:nn:ss dd-mm-yyyy"))
    element.appendChild node
   
    Set element = doc.createElement("gametype")
    root.appendChild element
   
    Set node = doc.createTextNode(GetVar("gamename"))
    element.appendChild node
   
    Set element = doc.createElement("score")
    root.appendChild element
   
    Set subelement = doc.createElement("Red")
    element.appendChild subelement
   
    Set node = doc.createTextNode(GetVar("Score_Red"))
    subelement.appendChild node
   
    Set subelement = doc.createElement("Blue")
    element.appendChild subelement
   
    Set node = doc.createTextNode(GetVar("Score_Blue"))
    subelement.appendChild node
   
   
    Set element = doc.createElement("players")
    root.appendChild element
   
    For Each objPlayer In colPlayers
        Set subelement = doc.createElement("player")
        element.appendChild subelement
       
        Set e = doc.createElement("name")
        subelement.appendChild e
       
        Set node = doc.createTextNode(objPlayer.Name)
        e.appendChild node
       
        Set e = doc.createElement("team")
        subelement.appendChild e
       
        Set node = doc.createTextNode(objPlayer.Team)
        e.appendChild node
       
        Set e = doc.createElement("ping")
        subelement.appendChild e
       
        Set node = doc.createTextNode(objPlayer.Ping)
        e.appendChild node
       
        Set e = doc.createElement("frags")
        subelement.appendChild e
       
        Set node = doc.createTextNode(objPlayer.Frags)
        e.appendChild node
    Next objPlayer
   
    doc.save App.Path & "\out.xml"
   
    Unload Me
End Sub

Public Function BeforeFirst(sHaystack As String, sNeedle As String) As String
  Dim iPos As Integer
 
  iPos = InStr(1, sHaystack, sNeedle)
 
  If iPos <> 0 Then
      BeforeFirst = Left$(sHaystack, iPos - 1)
  Else
      BeforeFirst = ""
  End If
End Function

Public Function AfterFirst(sHaystack As String, sNeedle As String) As String
    Dim iPos As Integer
   
    iPos = InStr(1, sHaystack, sNeedle)
   
    If iPos <> 0 Then
        'AfterFirst = Right(sHaystack, Len(sHaystack) - iPos)
        AfterFirst = Mid$(sHaystack, iPos + Len(sNeedle))
    Else
        AfterFirst = ""
    End If
End Function

Nice :)