Results 1 to 1 of 1

Thread: [VB6] Neopets Kitchen Quester

  1. #1
    Reemer's Avatar
    Joined
    Dec 2011
    Posts
    639
    Userbars
    8
    Thanks
    364
    Thanked
    446/256
    DL/UL
    39/0
    Mentioned
    203 times
    Time Online
    4d 13h 47m
    Avg. Time Online
    1m

    [VB6] Neopets Kitchen Quester

    Pretty similar to any other quester for almost any online game. Get quest, buy items, end quest, repeat. This one is probably a little cleaner, and it even has comments! I put it together in like 2 hours so it might not be too clean

    Code:
    Private Sub cmdStart_Click()
    Dim stritem As String
    Dim strRecipe As String
    Dim strshop As String
    Dim strwinnings As String
    Dim strprice As String
    Dim Finished As Boolean
    Dim strtotal As Integer
    Dim strquote As String
    strquote = """"
    cmdStart.Enabled = False
    cmdstop.Enabled = True
    StopProgram = False
    
    Do Until StopProgram = True
    'first quest page
    strtotal = 0
    lblstatus.Caption = "Getting quest."
    If StopProgram = False Then
    Call RipperWrapper.Request(strHTML, "GET", "http://www.neopets.com/island/kitchen.phtml", RipperWrapper.LastPage)
    
    'check for completion of all quests
    If InStr(strHTML, "Daily Quest Limit Reached") Then
    lststatus.AddItem ("Daily Quest Limit Reached. Stopping.")
    StopProgram = True
    End If
    'check for already started quest
    If InStr(strHTML, "Deadline") Then
    stritem = GetStringBetween(strHTML, "Ok, well I still need some ingredients from you!", "I have the Ingredients!")
    Call GBA(stritem, "><BR><B>", "</B>", lstitems, True)
    GoTo Buy
    End If
    
    
    strRecipe = GetStringBetween(strHTML, "Do you want to help me or not?", "I need you to go and")
    strRecipe = GetStringBetween(strRecipe, "<b>", "</b>")
    strRecipe = Replace(strRecipe, " ", "+")
    'recipe spaces are replaced with +'s
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    'get quest
    End If
    If StopProgram = False Then
    
    Call RipperWrapper.Request(strHTML, "POST", "http://www.neopets.com/island/kitchen2.phtml?food_desc=" & strRecipe, RipperWrapper.LastPage)
    lblstatus.Caption = "Got quest."
    Call GBA(strHTML, "width=80 border=1 height=80><br><b>", "</b>", lstitems, True)
    End If
    Buy:
    For i = 0 To lstitems.ListCount - 1
    
    If StopProgram = False Then
    'search for item
    lblstatus.Caption = "Searching for " & lstitems.List(i)
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call RipperWrapper.Request(strHTML, "GET", "http://www.neopets.com/market.phtml?type=wizard", RipperWrapper.LastPage)
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call RipperWrapper.Request(strHTML, "POST", "http://www.neopets.com/market.phtml?type=process_wizard&feedset=0&shopwizard=" & Replace(lstitems.List(i), " ", "+") & "&table=shop&criteria=exact&min_price=0&max_price=99999", RipperWrapper.LastPage)
    End If
    If InStr(strHTML, "I did not find anything.") Then
    lststatus.AddItem ("Quest is unbuyable. Stopping.")
    StopProgram = True
    Exit For
    End If
    If StopProgram = False Then
    
    strshop = GetStringBetween(strHTML, "/browseshop.phtml", """")
    lstshops.AddItem (strshop)
    strprice = GetStringBetween(strHTML, "<td align=" & strquote & "right" & strquote & " bgcolor=" & strquote & "#F6F6F6" & strquote & "><b>", "</b>")
    strprice = Replace(strprice, ",", "")
    lblcost.Caption = Val(lblcost.Caption) + Val(strprice)
    End If
    
    
    If Val(lblcost.Caption) > Val(txtmaxprice.Text) Then
    StopProgram = True
    lststatus.AddItem ("Quest too expensive. Stopping.")
    End If
    Next i
    If Val(lblcost.Caption) < Val(txtmaxprice.Text) Then
    For x = 0 To lstshops.ListCount - 1
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    If StopProgram = False Then
    lblstatus.Caption = "Buying " & lstitems.List(x) & "."
    Call RipperWrapper.Request(strHTML, "GET", "http://www.neopets.com/browseshop.phtml" & lstshops.List(x), RipperWrapper.LastPage)
    
    stritem = GetStringBetween(strHTML, "valign=" & strquote & "top" & strquote & "><A href=" & strquote, strquote)
    End If
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call RipperWrapper.Request(strHTML, "GET", "http://www.neopets.com/" & stritem, RipperWrapper.LastPage)
    If InStr(strHTML, "Sorry, you can only carry") Then
    lststatus.AddItem ("You are carrying too many items! Stopping.")
    StopProgram = True
    Exit For
    End If
    
    If InStr(strHTML, "Error:") Then
    lststatus.AddItem ("Not enough NP or other error occurred. Stopping.")
    StopProgram = True
    Exit For
    End If
    
    Next x
    If StopProgram = False Then
    lblstatus.Caption = "Turning in quest."
    Call RipperWrapper.Request(strHTML, "GET", "http://www.neopets.com/island/kitchen.phtml", RipperWrapper.LastPage)
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    Call RipperWrapper.Request(strHTML, "POST", "http://www.neopets.com/island/kitchen2.phtml?type=gotingredients", RipperWrapper.LastPage)
    
    If InStr(strHTML, "Come back when you have all the ingredients!") Then
    lststatus.AddItem ("Did not complete quest. Stopping.")
    StopProgram = True
    End If
    strwinnings = GetStringBetween(strHTML, "'><p><b>", "</b>")
    strwinnings = Replace(strwinnings, "<b>", "")
    strwinnings = Replace(strwinnings, "</b>", "")
    
    lststatus.AddItem (strwinnings)
    MSToWait (Rand(txtwait1.Text, txtwait2.Text))
    
    End If
    End If
    lstitems.Clear
    lstshops.Clear
    Loop
    lblstatus.Caption = "Idle..."
    
    
    End Sub
    Last edited by Reemer; 09-04-2012 at 11:21 AM.

  2. The Following 4 Users Say Thank You to Reemer For This Useful Post:

    Cody. (09-02-2012),Evelsaint (09-02-2012),j03 (09-04-2012),jojo (09-02-2012)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •