PDA

View Full Version : [VB6] Neopets Kitchen Quester



Reemer
09-02-2012, 11:15 AM
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 :P


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", "[Only registered and activated users can see links]", 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", "[Only registered and activated users can see links]" & 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", "[Only registered and activated users can see links]", RipperWrapper.LastPage)
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "POST", "[Only registered and activated users can see links]" & 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", "[Only registered and activated users can see links]" & 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", "[Only registered and activated users can see links]" & 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", "[Only registered and activated users can see links]", RipperWrapper.LastPage)
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "POST", "[Only registered and activated users can see links]", 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