1 Attachment(s)
[Solved]Doesn't check all players.
VB Code:
Private Sub Command1_Click()
If Winsock1.State = 0 Then Winsock1.Connect
Dim strHttpRequest As String
strHttpRequest = "GET /statistics/?subtopic=whoisonline&world=" & txtWorld.Text & vbCrLf
strHttpRequest = strHttpRequest & _
"Host: tibia.com" & vbCrLf
'add optional header "Accept"
strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
'add the "Connection" header to force
'the server to close the connection
'
'send the request
Winsock1.SendData strHttpRequest
Command1.Enabled = False
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Dim Char, Char2 As String
Dim CharPos1, CharPos2 As String
Dim I As Integer
For I = 0 To lstPlayer.ListCount
Char = lstPlayer.List(I)
CharPos1 = InStr(1, strData, Char, vbTextCompare)
If CharPos1 > 1 Then
lstStatus.AddItem Char + " : Online"
I = I + 1
ElseIf CharPos1 <= 1 Then
lstStatus.AddItem Char + " : Offline"
I = I + 1
End If
Next I
I = 0
For I = 0 To lstPlayer.ListCount
If lstStatus.List(I) = ": Offline" Then
lstStatus.RemoveItem I
End If
I = I + 1
Next I
End Sub
Private Sub Command3_Click()
MsgBox lstPlayer.List(I)
Open "vip.ini" For Output As #1
Print #1, strData
Close #1
End Sub
Private Sub Form_Load()
Winsock1.Connect
End Sub
Private Sub Timer1_Timer()
Command1.Enabled = True
Timer1.Enabled = False
Winsock1.Close
End Sub
Private Sub Winsock1_Connect()
lblStatus.Caption = "Online"
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.PeekData strData
'Text1.Text = strData & vbCrLf
End Sub
If now it only adds those who are online and doesn't check offline status. If you want to see for yourself I've added the exe file, to test write in the world 'Eternia'.