[vb6] Job Grabber Source

**Violent_J** · 06-24-2008, 12:31 AM

Now THIS is sexy code :P

Credits: Zach for the main code of his usershop ABer. Sorry, I edited it and added some stuff :/

Code:

 Option Explicit
Dim strSeller As String, strItem As String, strnum As String, strNP As String, strPrice As String, strtime As String, strreward As String, StopProgram As Boolean, X As Integer, sBuyLink As String, sBuyLink2 As String, HTML As String, nid As NOTIFYICONDATA2, strCheck As String, strJOBID As String, strGet As String

Public Function GB(rC As String, rS As String, rF As String, Optional lgB As Long = 1) As String
    On Error Resume Next
    lgB = InStr(lgB, rC, rS) + Len(rS): GB = Mid$(rC, lgB, InStr(lgB, rC, rF) - lgB)
End Function

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim msg As Long
    Dim sFilter As String
    msg = X / Screen.TwipsPerPixelX
    Select Case msg
    Case WM_LBUTTONDOWN2
    Me.Show ' show form
    Shell_NotifyIcon NIM_DELETE2, nid ' del tray icon
    Case WM_LBUTTONUP2
    Case WM_LBUTTONDBLCLK2
    Case WM_RBUTTONDOWN2
    Case WM_RBUTTONUP2
    Me.Show
    Shell_NotifyIcon NIM_DELETE2, nid
    Case WM_RBUTTONDBLCLK2
    End Select
End Sub

Sub minimize_to_tray()
    Me.Hide
    nid.cbSize = Len(nid)
    nid.hwnd = Me.hwnd
    nid.uId = vbNull
    nid.uFlags = NIF_ICON2 Or NIF_TIP2 Or NIF_MESSAGE2
    nid.uCallBackMessage = WM_MOUSEMOVE2
    nid.hIcon = Me.Icon ' the icon will be your Form1 project icon
    nid.szTip = "Violent_J's Job Grabber" & vbNullChar
    Shell_NotifyIcon NIM_ADD2, nid
End Sub


Private Sub Form_Load()
    StopProgram = False
    txtuser.Text = GetSetting("Violent_J's neopets login", "Login", "Username")
    txtpass.Text = GetSetting("Violent_J's neopets login", "Login", "Password")
End Sub

Private Sub cmdlogin_Click()
    Dim Jobnum As Integer
    cmdlogin.Enabled = False
    lblstatus.Caption = "Logging in..."
    HTML = w.Request("POST", "http://www.neopets.com/login.phtml?username=" & txtuser.Text & "&password=" & txtpass.Text & "&destination=%2Findex.phtml", "http://www.neopets.com/hi.phtml")
        If InStrB(1, HTML, txtuser.Text) Then
                strCheck = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=status", "http://www.neopets.com/faerieland/employ/employment.phtml")
                strJOBID = GB(strCheck, "<TD><A HREF=" & ChrW$(34) & "employment.phtml?type=desc&job_id=", "" & ChrW$(34) & ">Find")
                lblstatus.Caption = "Logged in as " & txtuser.Text & " "
                cmdlogin.Enabled = False
                cmdstart.Enabled = True
                cmdlogout.Enabled = True
                Call SaveSetting("Violent_J's neopets login", "Login", "Username", txtuser.Text)
                Call SaveSetting("Violent_J's neopets login", "Login", "Password", txtpass.Text)

        If InStrB(1, strCheck, ">Find") <> 0 Then
            lstlog.AddItem Time & " : You already have a job!", 0
            lblstatus.Caption = "You have a job..."
            HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=status")
            strnum = GB(HTML, "employment.phtml?type=desc&job_id=" & strJOBID & "" & ChrW$(34) & ">Find ", "&nbsp;")
            strItem = GB(HTML, ">Find " & strnum & "&nbsp;", "s.")
            txtnum.Text = strnum
            HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=desc&job_id=" & strJOBID)
        If InStrB(1, HTML, "completed this job already.") <> 0 Then
            strtime = "Job Completed!"
            strreward = GB(HTML, "<BR><BR>Base reward: ", "<BR><BR>")
            lblitem.Caption = strItem
            lblnum.Caption = strnum
            lbltime.Caption = strtime
            lblreward.Caption = strreward
            lblid.Caption = strJOBID
            txtitem.Text = strItem
        ElseIf InStrB(1, HTML, "Good job! You got all the items we wanted.") <> 0 Then
            lstlog.AddItem Time & " : Completed Job!", 0
            lblstatus.Caption = "Completed Job!"
            strtime = "Completed Job!"
            strreward = GB(HTML, "<BR><BR>Base reward: ", "<BR><BR>")
            lblitem.Caption = strItem
            lblnum.Caption = strnum
            lbltime.Caption = strtime
            lblreward.Caption = strreward
            lblid.Caption = strJOBID
            txtitem.Text = strItem
        Else
            strtime = GB(HTML, "neopoints<BR><BR>You have <B>", "</B>")
            strreward = GB(HTML, "<BR><BR>Base reward: ", "<BR><BR>")
            lblitem.Caption = strItem
            lblnum.Caption = strnum
            lbltime.Caption = strtime
            lblreward.Caption = strreward
            lblid.Caption = strJOBID
            txtitem.Text = strItem
    End If
        ElseIf InStrB(1, HTML, "badpassword") Then
                lblstatus.Caption = "Wrong password!"
                cmdlogin.Enabled = True
            ElseIf InStrB(1, HTML, "FROZEN") Then
                lblstatus.Caption = "Account frozen!"
                cmdlogin.Enabled = True
            ElseIf InStrB(1, HTML, "too many times") Then
                lblstatus.Caption = "Guessed password too many times!"
                cmdlogin.Enabled = True
        End If
    End If
  End Sub


Private Sub cmdclear_Click()
    lstlog.Clear
End Sub

Private Sub cmdcomplete_Click()
    lblstatus.Caption = "Attempting to complete Job..."
    w.Wait (1000)
    HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=desc&job_id=" & strJOBID)
        If InStrB(1, HTML, "So far you have acquired") <> 0 Then
            strGet = GB(HTML, "<BR><BR>So far you have acquired <B>", "&")
            lblstatus.Caption = "You Only Have " & strGet & "  " & strItem & "(s)"

        ElseIf InStrB(1, HTML, "Sorry!  You ran out of time on this job!") <> 0 Then
            lblstatus.Caption = "Ran out of time :("
            lstlog.AddItem Time & " : Failed job: Ran out of time!", 0
            lbltime.Caption = "Time run out!"
        ElseIf InStrB(1, HTML, "Good job! You got all the items we wanted.") <> 0 Then
            lblstatus.Caption = "Completed Job!"
            lstlog.AddItem Time & " :Completed Job!", 0
        Else
            lblstatus.Caption = "Unknown Error!"
    End If
End Sub

Private Sub cmdlogout_Click()
    cmdlogin.Enabled = True
    txtuser.Text = Empty
    txtpass.Text = Empty
    cmdlogout.Enabled = False
    HTML = w.Request("GET", "http://www.neopets.com/logout.phtml")
    lblstatus.Caption = "Idle..."
    cmdstart.Enabled = False
End Sub


Private Sub cmdquit_Click()
    lblstatus.Caption = "Quitting Job!"
    HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=desc&job_id=" & strJOBID & "&job_quit=1")
        If InStrB(1, HTML, "You don 't have the <B>200 neopoints</B> required to quit this job") <> 0 Then
            lblstatus.Caption = "Do not have 200 neopoints to quit this job!"
            lstlog.AddItem Time & " : Need 200 NP!", 0
        ElseIf InStrB(1, HTML, "You have chosen to quit this job.") <> 0 Then
            lblstatus.Caption = "Quit Job!"
            lstlog.AddItem Time & " : Quit Job!", 0
        ElseIf InStrB(1, HTML, "This job is currently unavailable. Please check back in 5 minutes.") <> 0 Then
            lblstatus.Caption = "You don't even have a job!"
            lstlog.AddItem Time & " : No job to quit 0_o", 0
        Else
            lblstatus.Caption = "Unknown Error - Contact Violent_J"
            lstlog.AddItem Time & " : Unknown Error!", 0
    End If
End Sub

Private Sub cmdstartwiz_Click()
    cmdstartwiz.Enabled = False
    cmdstopwiz.Enabled = True
    StopProgram = False
    tmrbuy.Enabled = True
    tmrbuy.Interval = txtwait.Text
    lblstatus.Caption = "Buying " & txtitem
    lstlog.AddItem Time & " : Searching shop wizard!", 0
End Sub

Private Sub cmdstopwiz_Click()
    StopProgram = True
    cmdstopwiz.Enabled = False
    cmdstartwiz.Enabled = True
    lblstatus.Caption = "Idle..."
    tmrbuy.Enabled = False
    lstlog.AddItem Time & " : Program Stopped!", 0
End Sub

Private Sub cmdstart_Click()
    StopProgram = False
    lstlog.AddItem Time & " : Program Started!", 0
    cmdstart.Enabled = False
    cmdstop.Enabled = True
    lstlog.AddItem Time & " : Waiting for Job openings..", 0
Do Until cmdstop.Enabled = False
    lblstatus.Caption = "Waiting " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Miliseconds For Jobs"
    HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=jobs&voucher=basic")
        If InStrB(1, HTML, "Base Neopoints Reward:") <> 0 Then
            lblstatus.Caption = "Jobs found"
            strJOBID = GB(HTML, "employment.phtml?type=apply&job_id=", "" & ChrW$(34) & ">Apply for this job")
            HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=apply&job_id=" & strJOBID, "http://www.neopets.com/faerieland/employ/employment.phtml?type=jobs&voucher=basic")
        If InStrB(1, HTML, "You have already taken enough jobs today!") <> 0 Then
            lblstatus.Caption = "Did too many jobs for the day!"
            lstlog.AddItem Time & " : Did too many jobs for the day!", 0
            cmdstart.Enabled = True
            cmdstop.Enabled = False
            StopProgram = True
        ElseIf InStrB(1, HTML, "This job has already been taken.") <> 0 Then
            lstlog.AddItem Time & " : Job Missed", 0
            lblstatus.Caption = "Job missed!"
        ElseIf InStrB(1, HTML, "You got the job!") <> 0 Then
            lblstatus.Caption = "You got the Job!"
            lstlog.AddItem Time & " : Got job!", 0
            Beep
            HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=status")
            strnum = GB(HTML, "employment.phtml?type=desc&job_id=" & strJOBID & "" & ChrW$(34) & ">Find ", "&nbsp;")
            strItem = GB(HTML, ">Find " & strnum & "&nbsp;", "s.")
            txtitem.Text = strItem
            txtnum.Text = strnum
            lblitem.Caption = strItem
            lblnum.Caption = strnum
            HTML = w.Request("GET", "http://www.neopets.com/faerieland/employ/employment.phtml?type=desc&job_id=" & strJOBID)
            strtime = GB(HTML, "neopoints<BR><BR>You have <B>", "</B>")
            strreward = GB(HTML, "<BR><BR>Base reward: ", "<BR><BR>")
            lbltime.Caption = strtime
            lblreward.Caption = strreward
            lblid.Caption = strJOBID
            cmdstop_Click
        Else
            lblstatus.Caption = "Unknown Error"
            lstlog.AddItem Time & " : Unknown Error!", 0
    End If
    End If
    w.Wait Int(Math.Rnd() * ((txty + 1) - txtx) + txtx)
    Loop
End Sub

Private Sub cmdstop_Click()
    lstlog.AddItem Time & " : Program Stopped!", 0
    lblstatus.Caption = "Idle..."
    cmdstop.Enabled = False
    cmdstart.Enabled = True
End Sub

Private Sub mnutray_Click()
    minimize_to_tray
End Sub

Private Sub tmrbuy_Timer()
        If X = txtnum.Text Or cmdstopwiz.Enabled = False Then
            tmrbuy.Enabled = False
            cmdstartwiz.Enabled = True
            cmdstopwiz.Enabled = False
            lblstatus.Caption = "Idle..."
            lstlog.AddItem Time & " : Bought all items!", 0
    End If
            lblstatus.Caption = "Visiting Shop Wizard"
            HTML = w.Request("GET", "http://www.neopets.com/market.phtml?type=wizard", w.LastPage)
            lblstatus.Caption = "Searching Shop Wizard for " & txtitem.Text
            HTML = w.Request("POST", "http://www.neopets.com/market.phtml?type=process_wizard&feedset=0&shopwizard=" & Replace(txtitem, " ", "+") & "&table=shop&criteria=exact&min_price=0&max_price=0", "http://www.neopets.com/market.phtml?type=wizard")
        If InStrB(1, HTML, "Whoa there, too many searches!") <> 0 Then
            lblstatus.Caption = "Wiz banned!"
            lstlog.AddItem Time & " : Wiz banned!", 0
        ElseIf InStrB(1, HTML, "I did not find anything") <> 0 Then
            txtitem.Text = txtitem.Text & "s"
            lstlog.AddItem Time & " : Didn't find anything", 0
            lblstatus.Caption = "Did not find anything!"
        ElseIf InStrB(1, HTML, "&buy_cost_neopoints=") <> 0 Then
            strSeller = GB(HTML, "#F6F6F6" & Chr(34) & "><a href=" & Chr(34) & "/browseshop.phtml?owner=", "&buy_obj_info_id")
            strPrice = GB(HTML, "&buy_cost_neopoints=", Chr(34) & "><b>" & strSeller)
            sBuyLink = GB(HTML, "<a href=""/browseshop.phtml?owner=", """><b>")
        If LenB(sBuyLink) = 0 Then
            lblstatus.Caption = "Did not find " & txtitem.Text
    End If
        HTML = w.Request("GET", "http://www.neopets.com/browseshop.phtml?owner=" & sBuyLink, "http://www.neopets.com/market.phtml")
        sBuyLink2 = GB(HTML, "<a href='buy_item.phtml?", "' onClick=")
                If LenB(sBuyLink2) = 0 Then
                    lblstatus.Caption = "Missed " & txtitem.Text
        
    End If
        HTML = w.Request("GET", "http://www.neopets.com/buy_item.phtml?" & sBuyLink2, w.LastPage)
                If InStrB(1, HTML, "browseshop.phtml?owner=" & sBuyLink & "&lower=0") Then
                    lstlog.AddItem Time & " : Bought " & txtitem.Text & " for " & GB(sBuyLink & "<E>", "&buy_cost_neopoints=", "<E>") & " NP", 0
                    X = X + 1
        Else
            lstlog.AddItem Time & " : Missed " & txtitem.Text, 0
    End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim frmTemp As Form
For Each frmTemp In Forms
    Unload frmTemp
    Set frmTemp = Nothing
Next
End
End Sub

Doctor · 06-24-2008, 04:11 AM

Its not "Sexy" code. Its pretty bad. Its not even completely automated.

EDIT::
Also, Good luck making the form. I wouldnt bother going through all the code for all the objects.

**Violent_J** · 06-24-2008, 06:43 AM

Quote:

Originally Posted by Doctor

Its not "Sexy" code. Its pretty bad. Its not even completely automated.

EDIT::
Also, Good luck making the form. I wouldnt bother going through all the code for all the objects.

Not suppose to be?
I am adding that feature for higher levels
this is the basic gist

I made the form already 0_o

Not suppose to be copied anyway
Just learned from

~~*Carnage*~~ · 06-24-2008, 09:38 AM

Learning from bad coding habits such as putting system tray in the main form, spacing inappropriately and being robust? Lulz.

**Violent_J** · 06-24-2008, 12:57 PM

Quote:

Originally Posted by Carnage

Learning from bad coding habits such as putting system tray in the main form, spacing inappropriately and being robust? Lulz.

I read your suggestion of putting the system tray in the wrapper
I will do it next time
I was too lazy :P.
I have been working on this for a long time :(

SPacing inappropriately?
I know, but it is the way I do it. I prefer this way then the "right way"

Robust?
Don't I have a right to be proud after weeks of work?