Money Grabber Source

[Aethean]

Not commented.. have fun :P

Option Explicit

Dim strHTML As String
Dim strStock() As String
Dim strBuyLink() As String
Dim lngMissed As Long
Dim lngGrabbed As Long
Dim lngRefreshes As Long
Dim X As Integer

Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Private Sub cmdLogin_Click()
cmdLogin.Enabled = False
txtUser.Enabled = False
txtPass.Enabled = False
status.Panels(1).Text = "Logging in... (1/3)"
strHTML = wrapper.Request("GET", "http://www.neopets.com/loginpage.phtml", "http://www.neopets.com/index.phtml")
wrapper.Wait (Rand(250, 500))
status.Panels(1).Text = "Logging in... (2/3)"
strHTML = wrapper.Request("POST", "http://www.neopets.com/hi.phtml?destination=/petcentral.phtml&username=" & txtUser.Text, "http://www.neopets.com/loginpage.phtml")
wrapper.Wait (Rand(250, 500))
status.Panels(1).Text = "Logging in... (3/3)"
strHTML = wrapper.Request("POST", "http://www.neopets.com/login.phtml?username=" & txtUser.Text & "&password=" & txtPass.Text & "&destination=/petcentral.phtml", "http://www.neopets.com/hi.phtml")
    If InStrB(1, strHTML, "Location: /petcentral.phtml") Then
        status.Panels(1).Text = "Logged into " & txtUser.Text
        strHTML = wrapper.Request("GET", "http://neopets.com/petcentral.phtml", wrapper.LastPage)
        lblNp.Caption = GetBetween(strHTML, "NP : <a class=tl href=/objects.phtml?type=inventory>", "</a>")
        status.Panels(1).Text = "Idle"
        cmdLogout.Enabled = True
        cmdStart.Enabled = True
    Else
        status.Panels(1).Text = "Login error; try again"
        cmdLogin.Enabled = True
        txtUser.Enabled = True
        txtPass.Enabled = True
        wrapper.ClearCookies
    End If
End Sub

Private Sub cmdLogout_Click()
status.Panels(1).Text = "Logging out..."
cmdLogout.Enabled = False
cmdLogin.Enabled = True
cmdStart.Enabled = False
cmdStop.Enabled = False
lblNp.Caption = vbNullString
wrapper.ClearCookies
status.Panels(1).Text = "Logged out"
End Sub

Private Sub cmdStart_Click()
    If Len(txtMin.Text) = 0 Or Len(txtMax.Text) = 0 Then
        MsgBox "Enter in a value for the timings", vbCritical, "Error"
        Exit Sub
    End If
    
    If Len(txtAbove.Text) = 0 Then
        MsgBox "Enter in the ammount and above to grab", vbCritical, "Error"
        Exit Sub
    End If
    
    
lngRefreshes = 0
status.Panels(1).Text = "Starting soon..."
cmdStart.Enabled = False
cmdStop.Enabled = True
tmrGrab.Enabled = True
tmrGrab.Interval = Rand(txtMin.Text * 1000, txtMax.Text * 1000)
End Sub

Private Sub cmdStop_Click()
status.Panels(1).Text = "Stopping"
cmdStart.Enabled = True
cmdStop.Enabled = False
tmrGrab.Enabled = False
tmrGrab.Interval = 0
status.Panels(1).Text = "Stopped"
End Sub

Private Sub form_unload(cancel As Integer)
wrapper.ClearCookies
End
End Sub

Private Sub tmrGrab_Timer()
Dim lngSecLeft As Long

Erase strStock
Erase strBuyLink

If chkBreak.Value = vbChecked Then
    If lngRefreshes >= Val(txtBreak.Text) Then
        lngSecLeft = Rand(2000, 2300)
        Do Until lngSecLeft = 0
        status.Panels(1).Text = "Pausing for " & lngSecLeft & " seconds"
        lngSecLeft = lngSecLeft - 1
        wrapper.Wait (1000)
        Loop
        lngRefreshes = 0
        lngSecLeft = 0
        Exit Sub
    End If
End If

status.Panels(1).Text = "Refreshing..."
    strHTML = wrapper.Request("GET", "http://www.neopets.com/donations.phtml", wrapper.LastPage)
    lngRefreshes = lngRefreshes + 1
        Call MatchAll(strHTML, "border=1></a><br><b>", "</b><br>", strStock)
        Call MatchAll(strHTML, "<td width=120 align=center valign=top><a href='", "'>", strBuyLink)
        For X = 0 To UBound(strStock)
            If InStr(1, strStock(X), "NP") Then
            strStock(X) = Replace(strStock(X), " NP", vbNullString)
                If Val(strStock(X)) > Val(txtAbove.Text) Then
                    Call GrabItem
                    Exit Sub
                        Else
                    status.Panels(1).Text = "Idle"
                End If
            End If
        Next X
    status.Panels(1).Text = "Idle"
    tmrGrab.Interval = Rand(txtMin.Text * 1000, txtMax.Text * 1000)
End Sub

Public Function GrabItem()
status.Panels(1).Text = "Attempting to get " & strStock(X) & " NP..."
    strHTML = wrapper.Request("GET", "http://www.neopets.com/" & strBuyLink(X), "http://www.neopets.com/donations.phtml")
        If InStrB(1, strHTML, "we hope you enjoy your") Then
            status.Panels(1).Text = "Grabbed " & strStock(X) & " NP!"
            lngGrabbed = lngGrabbed + strStock(X)
            lblGrabbed.Caption = lngGrabbed
                
                If chkDeposit.Value = vbChecked Then
                    Call DepositNeopoints
                End If
                
                Else
            lngMissed = lngMissed + strStock(X)
            lblMissed.Caption = lngMissed
            status.Panels(1).Text = "Missed... Idle"
        End If
End Function

Public Function DepositNeopoints()
status.Panels(1).Text = "Depositing neopoints..."
    strHTML = wrapper.Request("GET", "http://www.neopets.com/bank.phtml", wrapper.LastPage)
        strHTML = wrapper.Request("POST", "http://www.neopets.com/process_bank.phtml?type=deposit&amount=" & strStock(X), "http://www.neopets.com/bank.phtml")
    status.Panels(1).Text = strStock(X) & " NP deposited; Idle"
End Function

Private Sub Form_Initialize()
Call InitCommonControls
End Sub

Private Sub TrayWrapper1_DoubleClick()
    'alert on double click
    'MsgBox "User Double Clicked Icon"
    
    If Me.WindowState = vbMinimized Then 'form is minimized, bring it back
        Me.WindowState = vbNormal
        Me.Visible = True
        Me.ZOrder vbBringToFront
        TrayWrapper1.Hide
    End If
End Sub

Private Sub Form_Resize()
    If Me.WindowState = vbMinimized Then 'they minimized the form
        Me.Visible = False
        TrayWrapper1.Show
    End If
End Sub

Nice job. ;D +rep. =o

[Flame]

nice o.o stupid ripperwrapper

[Aethean]

Stupid ripperwrapper? i find it better than gluraks... and faster too lol

[Flame]

so silly xD, personal choice

[Aethean]

Oooooohhh.. I use to use gluraks httpwrapper.. but i didnt really like the

"http://www.neopets.com/login.php", "username=sdfsdf", wrapper.lastpage)

better in just 1 line i thinks :P

although tData kicks ass xD

-wishes I knew how to program -_- -

[Flame]

for only $25 ill teach you xDDD. Nah if you need help hit me up on msn ryan

[gommle]

VB code looks so incredibly messy, not to mention the incredibly long function names :P

Gommle, are you contributing this sorta thing..NO. -_-