auto checker if Stormstout server crashed

[strog]

So as you know there que when you trying to log on this realm, but if server crashed you have time to log on and play :)

So i wrote on VB program that checks if server on-line <3490 or it crashed.
you need to put some song named 1.mp3 in the same folder with program that will play when it detects crash
enjoy
https://www.dropbox.com/s/pr4ukzmhp3...ject1.exe?dl=0
fixed some bugs

for hellscream https://www.dropbox.com/s/oi2kpg9qm5...cream.exe?dl=0
ps. if you wont download this exe you can compile it yourself using visual basic

Spoiler: Show

Public z As Integer
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
z = 0
End Sub


Private Sub Timer1_Timer()
Dim timee As Integer
timee = Text1.Text
If timee <= 0 Then
MsgBox "invalid input"
Timer1.Enabled = False
z = 0
End If

z = z + 1
Text2.Text = timee * 60 - z
If z >= timee * 60 Then 'add timee*60
Text2.Text = 0
z = 0
Call proc

End If

End Sub

Sub proc()
Dim reportsFolder As String
Text2.Text = z
Dim Request As Object, s As String, p As Long, sLen As Integer, dlina As Integer
On Error Resume Next
Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
If Request Is Nothing Then
Set Request = CreateObject("WinHttp.WinHttpRequest.5")
End If

Request.Open "GET", "https://www.molten-wow.com/", False 'web
Request.Send

s = Request.Responsetext
s = Replace(s, " ", "")
dlina = InStr(1, s, "Stormstout")

valuee = Mid(s, dlina, InStr(dlina, s, "</span>" & vbCrLf & "</div>") - dlina)

dlina = InStr(1, valuee, "divclass")
valuee = Mid(valuee, dlina, InStr(dlina, s, "<span>") - dlina)

dlina = InStr(1, valuee, "<span>")
valuee = Mid(valuee, dlina, InStr(dlina, s, "<span>") - dlina)
dlina = Len(valuee)

valuee = Mid(valuee, 7, dlina - 7)
dlina = Len(valuee)

plrem = InStr(1, valuee, "p", vbTextCompare)
valuee = Left(valuee, plrem - 1)

'labels
'reportsFolder = Path.Combine(Directly.GetCurrentDirectory())
reportsFolder = Directory.GetCurrentDirectory

Text3.Text = valuee


If IsNumeric(valuee) = False Or valuee <= 3490 Then

temp = reportsFolder & "1.mp3"

CreateObject("WScript.Shell").Run temp
Timer1.Enabled = False
z = 0
End If
's = Replace(s, " ", "")
's = Replace(s, Chr$(34), "")

'If InStr(1, s, "<div class=players><span>", vbTextCompare) > 0 Then
'MsgBox s
' Else: MsgBox "doesnot work"
'End If
End Sub

pps. it can stop working correctly if there will be some "huge" main web page changes

[Elih4]

The source code won't work without the GUI elements

And for everyone that tries to run the executable, you need msstdfmt.dll (if you really want to run it get it here: https://superuser.com/questions/519841/getting-msstdfmt-dll-missing-when-starting-visual-basic-6-application)

[strog]

weird :)
just tried on my home pc (7 x64) it run ok, but not sure will it work if server crash :D

[1337]

Won't work. I can assure you that because the population counter isn't in real time. It's like a 5 minute difference.

[strog]

yes its got delay but you will have alot time to log in if you want, counter will become "unavaliable" value in 1-2 mins or even earlier


it works, not as fast as VBA (excel version) but works, it warned me while there was only ~1600 online after crash