It's pretty broken, but at least will tell you when someone joins. Annoyingly, the popup will probably knock you back to desktop after YOU join the Quake server, if you don't kill the script first. It also only checks one server. So this script needs lots of work...
The server IP needs to be changed, btw, to use it with another server (but who would want to do that?
).FvF-Poll.vbs:
Code: Select all
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const POLL_INTERVAL = 60000 '1000 x seconds
If Not objFSO.FileExists("qstat.exe") Then
objShell.Popup "Qstat.exe not found" + vbCrLf + "Verify that this script is in the qstat directory" _
+ strNumPlayers, , "Qstat problem", 48
Wscript.Quit
End If
Dim bogusTest ' as Boolean
bogustTest = False
Do Until bogusTest = True
WScript.Sleep POLL_INTERVAL
'objShell.Popup "Sleep test", 60, "FvF Status", 64
'Wscript.Quit
'objShell.Popup "Part 2", 60, "FvF Status", 64
ErrorCode = objShell.Run ("qstat -noconsole -qs fvf.servequake.com:26008 -R -P -of fvf-poll.xml -xml", 0, True)
'^^ 0 means run in background, True = wait for command (qstat) to finish ^^
'^^ Qstat parameters: -R = rules, -P = players, -of = output file, -xml = output type ^^
If ErrorCode <> 0 Then
objShell.Popup "Qstat ErrorCode: " + ErrorCode + vbCrLf + "Aborting." , 3 , "FvF Status", 48
WScript.Quit
End If
'====================
If Not objFSO.FileExists("fvf-poll.xml") Then
objShell.Popup "fvf-poll.xml file not generated by Qstat.exe " + vbCrLf + "Verify that this script is in the qstat directory" _
+ strNumPlayers, , "Qstat problem", 48
Wscript.Quit
End If
If Not objFSO.FileExists("fvf-poll.cfg") Then 'poll the server anyway, since this should be the first time run.
boolFirstRun = True
End If
Set objTextFile = objFSO.OpenTextFile _
("fvf-poll.xml", ForReading)
Set objCFG = objFSO.OpenTextFile _
("fvf-poll.cfg", ForReading, True) 'True = create if non-existent
Dim intLinePos 'as Integer
Dim strNumPlayers 'as String
Dim strServerXML
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
' objShell.Popup strNextLine, 5
intLinePos = InStr(strNextLine, "numplayers")
'TODO: Write strNumPlayers to a file
If intLinePos > 0 then ' numplayers found:
intLinePos = InStr(strNextLine, ">") + 1
strNumPlayers = Mid(strNextLine, intLinePos, 2)
If Not IsNumeric (Right(strNumPlayers, 1)) Then
strNumPlayers = Left(strNumPlayers, 1)
End If
Set objCFGTest = objFSO.GetFile("fvf-poll.cfg")
If objCFGTest.Size > 0 Then 'config just created.
strCFGLine = objCFG.Readline
'otherwise strCFGLine is empty so it won't match numplayers
End If
Set objCFGTest = Nothing
objCFG.Close
Set objCFG = Nothing
'TODO: Open file for writing. Write new numplayers
'objShell.Popup "strCFGLine*" + strCFGLine + "*"
'objShell.Popup "strNumPlayers*" + strNumPlayers + "*"
strServerXML = objTextFile.ReadAll
intLinePos = InStr(strServerXML, "<players>")
intLinePos2 = InStr(strServerXML, "</players>") - Len ("</players>")
intLinePos2 = intLinePos2 - intLinePos 'length of string
strServerXML = Mid(strServerXML, intLinePos + Len("<players>"), intLinePos2 )
If strCFGLine <> strNumPlayers Then
objShell.Popup "FVF status has changed: " + vbCrLf + vbCrLf + " Player(s): " + strNumPlayers + vbCrLf + _
strServerXML, 60, "FvF Status", 64
End If
'Set objCFG = objFSO.OpenTextFile _
' ("fvf-poll.cfg", ForReading, True)
Set objCFG = objFSO.OpenTextFile ("fvf-poll.cfg", ForWriting)
objCFG.Writeline strNumPlayers
'objShell.Popup "Sleep test 2", 60, "FvF Status", 64
End If
' arrServiceList = Split(strNextLine , ",")
Loop
Loop
objTextFile.Close
objCFG.Close
Set objShell = nothing
Set objTextfile = nothing
Set objCFG = nothing