Forum

[rcadble]

Originally Posted by Rockage

an mtger. Neopoint only btw. Learn from it, dont rip.

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 


It's funny how you say "don't rip" yet this code was ripped straight from me