VB.NET Source Codes

Can anyone tell me how to format the text so that it highlights for visual basic?
And if you guys want anything that isnt commented to be commented, then just post and I will.
Also, recently neopets has changed some of its code so i would test this before fully adding any of this code you your project.
Lastly, most of the functions are ricky's functions found in his module. If you guys need that posted I can add that or you can pm him probably.
Login:
I had this right in my wrapper so you may need to change some of this.

Code (Text):

1.  Public Function Login(ByRef Pass As String, ByRef User As String) As Boolean
2. 'frmMain.lblStatus.Text = "Logging in."
3. Dim strHTML As String
4. strHTML = Req("Post", "www.neopets.com/login.phtml?username=" & User & "&password=" & Pass & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml")
5. If InStr(strHTML, "badpassword") <> 0 Then
6. MsgBox("You entered an invalid username/password combination!" & vbNewLine & "Please try again.", vbCritical, "Login Failure")
7. Login = False
8. 'Check if account is frozen.
9. ElseIf InStr(strHTML, "This account has been") <> 0 Then
10. MsgBox("ACCOUNT FROZEN!" & vbNewLine & "Please use another.", vbCritical, "Login Failure")
11. Login = False
12. 'Check if we tried to login to many times.
13. ElseIf InStr(strHTML, "too many times") <> 0 Then
14. MsgBox("You have tried to guess the password to many times in the last hour!" & vbNewLine & "Try again later.", vbCritical, "Login Failure")
15. 'If we passed all of the above, then we're logged in.
16. Login = False
17. Else
18. Login = True
19. Exit Function
20. End If
21. End Function

Stuff For Restocking:

Code (Text):

1.  Private Sub After()
2. strHTML = w.Req("Get", "http://www.neopets.com/objects.phtml?type=inventory", "")
3. Dim stuffs() As String
4.  
5. stuffs = rickysModule.MatchAll(strHTML, "onclick=" & Chr(34) & "openwin(", ")")
6. If stuffs(0) = "" Then
7. SetText(lbPLog, Now & " - Error in After Buy.")
8. Exit Sub
9. End If
10. w.Req("Get", "http://www.neopets.com/iteminfo.phtml?obj_id=" & stuffs(UBound(stuffs)), "http://www.neopets.com/objects.phtml?type=inventory")
11. If rbStock.Checked = True Then
12. w.Req("Post", "http://www.neopets.com/useobject.phtml?obj_id=" & stuffs(UBound(stuffs)) & "&action=stockshop", "http://www.neopets.com/iteminfo.phtml")
13. SetText(lbPLog, Now & " - Item stocked in shop.")
14. ElseIf rbDeposit.Checked = True Then
15. w.Req("Post", "http://www.neopets.com/useobject.phtml?obj_id=" & stuffs(UBound(stuffs)) & "&action=safetydeposit", "http://www.neopets.com/iteminfo.phtml")
16. SetText(lbPLog, Now & " - Item deposited in SDB.")
17. ElseIf rbGallery.Checked = True Then
18. w.Req("Post", "http://www.neopets.com/useobject.phtml?obj_id=" & stuffs(UBound(stuffs)) & "&action=stockgallery", "http://www.neopets.com/iteminfo.phtml")
19. SetText(lbPLog, Now & " - Item placed in gallery.")
20. ElseIf rbNeoFriend.Checked = True Then
21. w.Req("Post", "http://www.neopets.com/useobject.phtml?obj_id=" & stuffs(UBound(stuffs)) & "&action=give", "http://www.neopets.com/iteminfo.phtml")
22. w.Req("Post", "http://www.neopets.com/useobject.phtml?obj_id=" & stuffs(UBound(stuffs)) & "&action=&or_name=" & txtNeofriend.Text, "http://www.neopets.com/useobject.phtml")
23. SetText(lbPLog, Now & " - Item given to Neofriend.")
24. Else
25. SetText(lbPLog, Now & " - After buy messed up.")
26. End If
27. End Sub

OCR: Basically ricky's ocr with some parts taken out. Just thought I should include it.

Code (Text):

1.  Public Function ONRScan(ByRef picBox As PictureBox) As Point
2. Dim neopetPicture As Bitmap = DirectCast(picBox.Image, Bitmap)
3. Dim now As Integer = DateTime.Now.Millisecond
4. Dim width As Integer = neopetPicture.Width, height As Integer = neopetPicture.Height
5. Dim unPixel As Color = Color.White
6. Dim darkPixel As Color = Color.White
7. For a As Integer = 0 To height - 1 Step 10
8. For b As Integer = 0 To width - 1 Step 10
9. unPixel = neopetPicture.GetPixel(b, a)
10. If unPixel.GetBrightness() < darkPixel.GetBrightness() Then
11. darkPixel = unPixel
12. ONRScan.X = b
13. ONRScan.Y = a
14. End If
15. Next
16. Next
17. 'Dim fin As Integer = DateTime.Now.Millisecond
18. 'MessageBox.Show("The neopet is at :" + ONRScan.X.ToString() + ", " + ONRScan.Y.ToString() + " and was found in " + (fin - now).ToString() + " ms.")
19. 'For p As Integer = 0 To width - 2
20. ' neopetPicture.SetPixel(p, ONRScan.Y, Color.White)
21. 'Next
22. 'For k As Integer = 0 To height - 2
23. ' neopetPicture.SetPixel(ONRScan.X, k, Color.White)
24. 'Next
25. 'picBox.Image = neopetPicture
26. End Function

Auto Buy Function with Addons Built in:
Addons were:
Rsban Checker
Timed Buy/Timed Wait
Checks login every 20 refreshes.

Code (Text):

1. 'Auto buying function
2. Public Sub AutoBuy()
3. If chkShopBanned.Checked = True Then
4. Dim banned As Boolean = False
5. Do While banned = False
6. strHTML = w.Req("Get", "http://neopets.com/objects.phtml?type=shop&obj_type=21", "")
7. If strHTML.Contains("Sorry, we are sold out of everything!") Then
8. SetText(lbPLog, Now & " - RS Banned. Check again in " & txtBannedCheck.Text & " Minutes")
9. For i As Integer = 1 To (txtBannedCheck.Text * 60)
10. Thread.Sleep(1000)
11. If cmdStart.Text = "Start" Then
12. i = (txtBannedCheck.Text * 60)
13. End If
14. Next
15. Else
16. SetText(lbPLog, Now & " - Not RS Banned. Check again in " & txtBannedCheck.Text & " Minutes")
17. banned = True
18. End If
19. Loop
20. waitTimeSecond = Now.AddMinutes(txtRun.Text)
21. End If
22. If chkRunandPause.Checked = True Then
23. rsTimeSecond = Now.AddMinutes(txtBannedCheck.Text)
24. SetText(lbPLog, Now & " - Running Program for " & txtRun.Text & " Minutes")
25. End If
26.  
27. Do While cmdStart.Text = "Stop"
28. Dim pol As Point
29. Dim Items() As String
30. Dim Links() As String
31. Dim Prices() As String
32. Dim Bought As Boolean = False
33. strHTML = w.Req("GET", "http://www.neopets.com/objects.phtml?type=shop&obj_type=" & CStr(txtShop.Text), "")
34. 'If there are items in the shop, checks to see what items are there
35. If strHTML.Contains("Are you sure you wish to purchase") Then
36. Items = rickysModule.MatchAll(strHTML, "Are you sure you wish to purchase ", " at ")
37. Links = rickysModule.MatchAll(strHTML, "onClick=" & Chr(34) & "this.href='haggle.phtml?ob'+'j", "'")
38. Prices = rickysModule.MatchAll(strHTML, "in stock<BR>Cost: ", " ")
39. Dim i As Short = 0
40. Do Until i = lbItemWanted.Items.Count
41. For p As Short = 0 To UBound(Items)
42. If Items(p).Equals(lbItemWanted.Items.Item(i)) Then
43. strHTML = w.Req("Get", "http://www.neopets.com/haggle.phtml?obj" & Links(p), "http://www.neopets.com/objects.phtml?type=shop&obj_type=" & txtShop.Text)
44.  
45. If InStr(1, strHTML, " is SOLD OUT!") <> 0 Then
46. 'lstLog.AddItem(Time & " - Missed " & lstItemsPage.List(x) & ". Item Sold out.")
47. Else
48. xPic.Image = w.DownloadJPG("http://www.neopets.com/captcha_show.phtml?_x_pwned=" & rickysModule.GetBetween(strHTML, "/captcha_show.phtml?_x_pwned=", ChrW(34)), "")
49. pol = w.ONRScan(xPic)
50.  
51. SetText(lbAll, Now & " - Attempting to Buy " & Items(p))
52. SetText(lbAttempt, Now & " - Attempting to Buy " & Items(p))
53.  
54. strHTML = w.Req("POST", "http://www.neopets.com/haggle.phtml?current_offer=" & CInt(System.Math.Round(Prices(p) * txtHaggle.Text * 0.01, 0)) & "&x=" & CStr(pol.X) & "&y=" & CStr(pol.Y), "http://www.neopets.com/haggle.phtml?obj" & Links(p))
55. If InStr(1, strHTML, "has been added to your inventory") <> 0 Then
56. 'Logs
57. SetText(lbAll, Now & " - Bought " & Items(p) & " for " & System.Math.Round(Prices(p) * txtHaggle.Text * 0.01, 0))
58. SetText(lbBought, Now & " - Bought " & Items(p) & " for " & System.Math.Round(Prices(p) * txtHaggle.Text * 0.01, 0))
59. SetText(tsAttemp, tsAttemp.Text + 1)
60. SetText(tsBought, tsBought.Text + 1)
61. SetText(tsSpent, tsSpent.Text + CInt(System.Math.Round(Prices(p) * txtHaggle.Text * 0.01, 0)))
62. SetText(lbPLog, Now & " - Waiting 6000 miliseconds")
63. 'Add Deposit, Stock etc stuff here.
64. If Not rbNothing.Checked = True Then
65. Call After()
66. End If
67. 'Sleeps
68. Thread.Sleep(5200)
69. Bought = True
70. Exit Do
71. ElseIf InStr(1, strHTML, "SOLD OUT!") <> 0 Then
72. AttMiss(Items, p)
73. ElseIf InStr(1, strHTML, "You don't have that kind of money") <> 0 Then
74. AttMiss(Items, p, "Not Enough NP")
75. SetText(lbPLog, Now & " - Withdrawing " & txtAmountWith.Text & " Neopoints.")
76. w.Req("Get", "http://www.neopets.com/bank.phtml", "")
77. If chkPIN.Checked = False Then
78. w.Req("Post", "http://www.neopets.com/process_bank.phtml?type=withdraw&amount=" & txtAmountWith.Text, "http://www.neopets.com/bank.phtml")
79. Else
80. w.Req("Post", "http://www.neopets.com/process_bank.phtml?type=withdraw&amount=" & txtAmountWith.Text & "&pin=" & txtPIN.Text, "http://www.neopets.com/bank.phtml")
81. End If
82. ElseIf InStr(1, strHTML, "You must select the correct pet") <> 0 Then
83. AttMiss(Items, p, "Wrong Pet")
84. ElseIf InStr(1, strHTML, "Your Current Offer</b> : ") <> 0 Then
85. AttMiss(Items, p, "Offer To Low")
86. ElseIf InStr(1, strHTML, "Sorry, you can only carry") <> 0 Then
87. AttMiss(Items, p, "To many items")
88. Else
89. 'Error Section
90. SetText(lbPLog, Now & " : Error Unknown.")
91. End If
92.  
93. End If
94.  
95. 'Leaves the loop
96. Exit Do
97. End If
98. Next
99. i = i + 1
100. Loop
101.  
102.  
103. End If
104.  
105. If Bought = False Then
106. 'Wait Time
107. Dim mili As Short
108. mili = rickysModule.MakeRandom(txtMin.Text * 1000, txtMax.Text * 1000)
109. SetText(lbPLog, Now & " - Waiting " & mili & " miliseconds")
110. Thread.Sleep(mili)
111. LoginCheck += 1
112. 'Login Check
113. If LoginCheck >= 20 And strHTML.Contains("Login to Neopets!") Then
114. w.Login(txtPass.Text, txtUser.Text)
115. SetText(lbPLog, Now & " - Logged back in to Neopets")
116. LoginCheck = 0
117. ElseIf LoginCheck >= 20 Then
118. SetText(lbPLog, Now & " - Currently Logged into Neopets")
119. LoginCheck = 0
120. End If
121. End If
122.  
123. If chkShopBanned.Checked = True And Now > rsTimeSecond Then
124. strHTML = w.Req("Get", "http://neopets.com/objects.phtml?type=shop&obj_type=21", "")
125. If strHTML.Contains("Sorry, we are sold out of everything!") Then
126. SetText(lbPLog, Now & " - RS Banned. Check again in " & txtBannedCheck.Text & " Minutes")
127. For i As Integer = 1 To (txtBannedCheck.Text * 60)
128. Thread.Sleep(1000)
129. If cmdStart.Text = "Start" Then
130. i = (txtBannedCheck.Text * 60)
131. End If
132. Next
133. Else
134. SetText(lbPLog, Now & " - Not RS Banned. Check again in " & txtBannedCheck.Text & " Minutes")
135. End If
136. rsTimeSecond = Now.AddMinutes(txtBannedCheck.Text)
137. End If
138.  
139. If chkRunandPause.Checked = True And Now > waitTimeSecond Then
140. SetText(lbPLog, Now & " - Pausing Program for " & txtPause.Text & " Minutes")
141. For i As Integer = 1 To (txtPause.Text * 60)
142. Thread.Sleep(1000)
143. If cmdStart.Text = "Start" Then
144. i = (txtPause.Text * 60)
145. End If
146. Next
147. SetText(lbPLog, Now & " - Running Program for " & txtRun.Text & " Minutes")
148. waitTimeSecond = Now.AddMinutes(txtRun.Text)
149. rsTimeSecond = Now.AddMinutes(txtBannedCheck.Text)
150. End If
151.  
152.  
153.  
154. Loop
155. SetText(lbPLog, Now & " - Program Stopped")
156. SetText(lbStatus, "Stopped")
157. End Sub

Friend Finder Source:
Contains 3 Functions:
1)Find
2)Friend Request
3)Auction Check - Checks friends and finds neofriend only auctions to steal their items

Code (Text):

1.  
2. Private Sub Fird()
3. Dim y As Long
4. y = 0
5. Call SetTextL(lblFFStatus, "Grabbing Names from Avatar Board")
6. 'href="/randomfriend.phtml?user=, "
7. For x As Integer = 0 To 20
8. strHTML = w.Req("Get", "http://neopets.com/neoboards/boardlist.phtml?board=21&next=" & y, "")
9. Call Extract(lbFFList)
10. y = y + 41
11. Wait(300)
12. Next
13. y = 0
14.  
15.  
16. Call SetTextL(lblFFStatus, "Grabbing Names from Stock Board")
17. For x As Integer = 0 To 20
18. strHTML = w.Req("Get", "http://neopets.com/neoboards/boardlist.phtml?board=12&next=" & y, "")
19. Call Extract(lbFFList)
20. y = y + 41
21. Wait(300)
22. Next
23. y = 0
24.  
25.  
26. Call SetTextL(lblFFStatus, "Grabbing Names from Auctions")
27. For x As Integer = 0 To 20
28. strHTML = w.Req("Get", "http://neopets.com/auctions.phtml?auction_counter=" & y, "")
29. Call Extract(lbFFList)
30. y = y + 20
31. Wait(300)
32. Next
33. y = 0
34. 'Call SetTextL(lblFFStatus, "Removing Dupes")
35. 'rickysModule.RemoveDupes(lbFFList)
36.  
37.  
38. Call SetTextL(lblFFStatus, "Done, Grabbed " & lbFFList.Items.Count & " Names")
39. 'cmdFFStart.Text = "Start"
40. Me.Frd.Suspend()
41. End Sub
42.  
43.  
44. Public Sub FrRequest()
45. For i As Integer = 0 To lbFRList.Items.Count - 1
46. strHTML = w.Req("Get", "http://www.neopets.com/neofriend_requests.phtml", "")
47. strHTML = w.Req("Post", "http://www.neopets.com/process_neofriend_requests.phtml?_ref_ck=" & rickysModule.GetBetween(strHTML, "name='_ref_ck' value='", "'") & "&neofriend_add=" & lbFRList.Items.Item(i) & "++&dowhat=add_single_neofriend", "http://neopets.com/neofriend_requests.phtml")
48. If strHTML.Contains("Not receiving Neofriend requests") Then
49. SetText(lbFrLog, lbFRList.Items.Item(i) & " is not accepting requests.")
50. Else
51. SetText(lbFrLog, lbFRList.Items.Item(i) & " added as Friend.")
52. End If
53. Wait(txtSpeed.Text)
54. Next
55. SetText(lbFrLog, Now & " - Program Finished.")
56. End Sub
57.  
58.  
59.  
60. Private Sub PowerAuction()
61. 'Gets Info
62. Dim strUserNames() As String
63. Dim strAccepted() As String
64. Dim bolPowerStarter As Boolean = True
65. Dim intPlacement As Integer = 0
66. Do Until bolPowerStarter = False
67. strHTML = w.Req("Get", "http://neopets.com/**********.phtml?view=all&search=&range=&page=" & intPlacement, "")
68. strUserNames = rickysModule.MatchAll(strHTML, "<a href='randomfriend.phtml?randomfriend=", "'")
69. strAccepted = rickysModule.MatchAll(strHTML, "size=1>", "<")
70.  
71.  
72.  
73.  
74. 'Makes the list
75. Dim i As Integer
76. For i = 0 To UBound(strUserNames)
77. SetText(ListBox1, strAccepted(i))
78. If strAccepted(i) = "Accepted!" Then
79. strHTML = w.Req("Get", "http://neopets.com/genie.phtml?type=find_user&auction_username=" & strUserNames(i), "")
80. If strHTML.Contains("auctions.phtml?type=bids&auction_id=") = True Then
81. Dim Items() As String
82. Dim Links() As String
83. Links = rickysModule.MatchAll(strHTML, "auctions.phtml?type=bids&auction_id=", Chr(34))
84. Dim x As Integer
85. For x = 0 To UBound(Links)
86. Items(x) = rickysModule.GetBetween(strHTML, "auctions.phtml?type=bids&auction_id=" & Chr(34) & Items(x), "<")
87. 'ListBox1.Items.Add(Items(x) & " - " & "http://www.neopets.com/auctions.phtml?type=bids&auction_id=" & Links(x))
88. SetText(ListBox1, Items(x) & " - " & "http://www.neopets.com/auctions.phtml?type=bids&auction_id=" & Links(x))
89. Next
90. Else
91. SetText(ListBox1, strUserNames(i) & " has no auctions.")
92. End If
93. End If
94. Wait(txtAFSpeed.Text)
95. Next
96. intPlacement = intPlacement + 1
97. If strHTML.Contains("Next") = False Then
98. bolPowerStarter = False
99. End If
100. Wait(txtAFSpeed.Text)
101. Loop
102. End Sub
103.  

Money Tree Source:
Unfinished if I remember correctly
Features:Grabs NP, Grabs Items, Grabs *contains

Code (Text):

1. Private Sub TreeSub(ByRef username As String, ByRef password As String, Optional ByRef proxy As String = "")
2. Dim time As Double ' Used to get a random time
3. Dim Yes As Boolean = False ' used for login
4. Dim activate As Boolean = True ' used to make sure login is correct
5. Dim Bought As Byte = 0 ' used to keep track of how many item grab the user gets
6. w.ClearCookies()
7. If Not proxy = "" Then
8. w.UseProxy(rickysModule.ParseLeft(proxy, ":"), rickysModule.ParseRight(proxy, ":"))
9. Else
10. w.NoProxy()
11. End If
12. Yes = w.Login(txtUser.Text, txtPass.Text)
13. If Yes = True Then
14. SetText(lbLog, "Logged in account " & username)
15. strHTML = w.Req("GET", "http://www.neopets.com/index.phtml", "")
16. activate = True
17. Else
18. SetText(lbLog, "Problem Loggin in Account " & username)
19. activate = False
20. End If
21.  
22. Do While cmdStart.Text = "Stop" And activate = True
23. strHTML = w.Req("Get", "http://www.neopets.com/donations.phtml", "")
24. If strHTML.Contains("<BR>(donated by") Then
25. 'Retrives all the data about the page, links, np and who donated
26. Dim Links() As String = rickysModule.MatchAll(strHTML, "<a href='takedonation_new.phtml?donation_id=", "'")
27. Dim Items() As String = rickysModule.MatchAll(strHTML, "<br><b>", "</b><br>")
28. Dim i As Short
29. Do While i < lbList.Items.Count - 1
30. For x As Short = 0 To UBound(Items) - 1
31. If lbList.Items.Item(i).Equals(Items(x)) Then
32. strHTML = w.Req("Get", "http://www.neopets.com/takedonation_new.phtml?donation_id=" & Links(x), "http://neopets.com/donations.phtml")
33. 'logs you got or missed it, also if there is something messed up ends the grabbing
34. toolAttempts.Text += 1
35. If strHTML.Contains("You got it!") Then
36. lbLog.Items.Add(Now & " : Grabbed " & Items(x))
37. toolGrabbed.Text += 1
38. Bought += 1
39. ElseIf InStr(1, strHTML, "Oops") <> 0 Then
40. lbLog.Items.Add(Now & " : Missed " & Items(x))
41. toolMissed.Text += 1
42. End If
43. ElseIf lbList.Items.Item(i).ToString.Contains("*") And Items(x).Contains(lbList.Items.Item(i).ToString.Substring(0, lbList.Items.Item(i).ToString.Length - 1)) Then
44. strHTML = w.Req("Get", "http://www.neopets.com/takedonation_new.phtml?donation_id=" & Links(x), "http://neopets.com/donations.phtml")
45. 'logs you got or missed it, also if there is something messed up ends the grabbing
46. toolAttempts.Text += 1
47. If strHTML.Contains("You got it!") Then
48. lbLog.Items.Add(Now & " : Grabbed " & Items(x))
49. toolGrabbed.Text += 1
50. Bought += 1
51. ElseIf InStr(1, strHTML, "Oops") <> 0 Then
52. lbLog.Items.Add(Now & " : Missed " & Items(x))
53. toolMissed.Text += 1
54. End If
55. ElseIf Items(x).Contains(" NP") And rickysModule.GetBetween(Items(x), "", " NP") >= txtNPMin.Text Then
56. strHTML = w.Req("Get", "http://www.neopets.com/takedonation_new.phtml?donation_id=" & Links(x), "http://neopets.com/donations.phtml")
57. 'logs you got or missed it, also if there is something messed up ends the grabbing
58. toolAttempts.Text += 1
59. If strHTML.Contains("You got it!") Then
60. lbLog.Items.Add(Now & " : Grabbed " & Items(x))
61. toolGrabbed.Text += 1
62. Bought += 1
63. ElseIf InStr(1, strHTML, "Oops") <> 0 Then
64. lbLog.Items.Add(Now & " : Missed " & Items(x))
65. toolMissed.Text += 1
66. End If
67. End If
68. Next
69. Loop
70.  
71. i += 1
72. End If
73. time = rickysModule.MakeRandom(txtMin.Text * 1000, txtMax.Text * 1000)
74. SetText(lbLog, Now & " - Refreshed for " & time & " secs.")
75. Thread.Sleep(time)
76. If Bought >= 10 Then
77. Exit Sub
78. End If
79. Loop
80.  
81.  
82.  
83. End Sub

Enjoy.

 

thankyou alot man 8)

 

This is VB6. Not Vb.NET

 

It seems to work with VB.NET perfectly well. Although I've tested one of them only.

 

The indentation makes me want to kill a few thousand children.