an mtger. Neopoint only btw. Learn from it, dont rip.
Thanks to rcad.
PHP Code:
Option Explicit
Private Type Item
Amount As Long
OrigID As Long
End Type
Dim lngPrev As Long
Dim strStock() As String
Private Sub cmdLogin_Click()
Dim strHTML As String
cmdLogin.Enabled = False
strHTML = HTTP.GetWrapper("http://neopets.com/")
stbStatus.Panels(1).Text = "Status: " & "Logging In Step 1"
strHTML = HTTP.GetWrapper("http://neopets.com/loginpage.phtml", "http://neopets.com/")
stbStatus.Panels(1).Text = "Status: " & "Logging In Step 2"
strHTML = HTTP.GetWrapper("http://neopets.com/hi.phtml?destination=%2Fpetcentral.phtml&username=" & txtUsername.Text, "http://neopets.com/loginpage.phtml")
stbStatus.Panels(1).Text = "Status: " & "Logging In Step 3"
strHTML = HTTP.GetWrapper("http://neopets.com/login.phtml?username=" & txtUsername.Text & "&password=" & txtPassword.Text & "&destination=%2Fpetcentral.phtml", "http://neopets.com/hi.phtml?destination=%2Fpetcentral.phtml&username=" & txtUsername.Text)
stbStatus.Panels(1).Text = "Status: " & "Logging In Step 4"
If InStr(1, LCase(strHTML), "location: /petcentral.phtml") <> 0 Or InStr(1, LCase(strHTML), "pass_remind") <> 0 Then
stbStatus.Panels(1).Text = "Status: " & "Login Successful!"
MsgBox "Login Successful!"
txtUsername.Enabled = False
txtPassword.Enabled = False
stbStatus.Panels(1).Text = "Status: " & "Logged in as " & txtUsername.Text
ElseIf InStr(1, LCase(strHTML), "frozen") <> 0 Then
cmdLogin.Enabled = True
MsgBox "This account is frozen!"
stbStatus.Panels(1).Text = "Status: " & "Account Frozen!"
Else
cmdLogin.Enabled = True
MsgBox "Invalid user/password combination!"
stbStatus.Panels(1).Text = "Status: " & "Invalid user/pass combination!"
End If
End Sub
Private Sub cmdStart_Click()
'set the interval nub
lstLog.AddItem (Time & ": MTG STARTED!")
tmrRef.Interval = RcadModule.Rand(500, 1000)
tmrRef.Enabled = True
stbStatus.Panels(1).Text = "Status: Checking the tree."
End Sub
Private Sub cmdStop_Click()
lstLog.AddItem (Time & ": MTG STOPED!")
tmrRef.Enabled = False
tmrRef.Interval = RcadModule.Rand(500, 1000)
stbStatus.Panels(1).Text = "Status: stopped."
End Sub
Private Sub tmrRef_Timer()
Dim strHTML As String
Dim i As Long
Dim itmItem() As Item
Dim lngCount As Long: lngCount = 0
Dim lngHighest As Long: lngHighest = 0
Dim lngID As Long
Erase strStock()
lstNP.Clear
strHTML = HTTP.GetWrapper("http://www.neopets.com/donations.phtml", HTTP.LastPage)
lngPrev = Replace(Extract(strHTML, "NP : <a class=tl href=/objects.phtml?type=inventory>", "</a>"), ",", "")
If InStr(1, strHTML, "<br>(donated by ") <> 0 Then
Call RcadModule.ExtractAll(strHTML, "border=1></a><br><b>", "</b><br>", strStock())
For i = LBound(strStock) To UBound(strStock)
lstNP.AddItem strStock(i)
Next
ReDim Preserve itmItem(lstNP.ListCount) As Item
For i = LBound(strStock) To UBound(strStock)
If InStr(1, strStock(i), " NP") <> 0 Then
itmItem(i).Amount = Val(Replace(strStock(i), " NP", ""))
itmItem(i).OrigID = i
lngCount = Val(lngCount) + 1
End If
Next
If lngCount > 0 Then
For i = LBound(itmItem) To UBound(itmItem)
If itmItem(i).Amount > lngHighest Then
lngHighest = itmItem(i).Amount
lngID = i
End If
Next
If lngHighest >= Val(txtmin.Text) Then
Call grabItem(itmItem(lngID).OrigID, strHTML)
Exit Sub
End If
End If
Else
lstNP.AddItem ("Nothing on tree.")
End If
tmrRef.Interval = Rand(500, 1000)
stbStatus.Panels(1).Text = "Status: Waiting " & tmrRef.Interval & " ms!"
End Sub
Public Function grabItem(ByVal id As Long, ByVal strHTML As String)
Dim strURLS() As String
Dim strURL As String
Dim lngAfter As Long
Call RcadModule.ExtractAll(strHTML, "<a href='takedonation_new.phtml?donation_id=", "'", strURLS())
strURL = "http://www.neopets.com/takedonation_new.phtml?donation_id=" & strURLS(id)
strHTML = HTTP.GetWrapper(strURL, HTTP.LastPage)
strHTML = HTTP.GetWrapper("http://www.neopets.com/objects.phtml", HTTP.LastPage)
lngAfter = Replace(Extract(strHTML, "NP : <a class=tl href=/objects.phtml?type=inventory>", "</a>"), ",", "")
If lngAfter > lngPrev Then
lstLog.AddItem (Time & ": Grabbed " & strStock(id) & "!")
Else
lstLog.AddItem (Time & ": Missed " & strStock(id) & "!")
End If
End Function
