Always debated releasing the source since this took me awhile to do. Some of it should be done other ways, but whatever. Download at the bottom. frmmain - Code (Text): Dim strhtml As String, petname1 As String, petname2 As String, petname3 As String, petspecies1 As String, petspecies2 As String, petspecies3 As String, petcolor1 As String, petcolor2 As String, petcolor3 As String, status As String, nps As String, activepet As String, petdef1 As String, petdef2 As String, petdef3 As String, petstr1 As String, petstr2 As String, petstr3 As String, petlev1 As String, petlev2 As String, petlev3 As String, specificcolor As String, specificspecies As String Public Function Random(Lowerbound As Long, Upperbound As Long) Randomize Random = Int(Rnd * Upperbound) + Lowerbound End Function Private Sub addcolor_Click() lstcolor.AddItem "" & txtcolor.Text txtcolor.Text = "" End Sub Private Sub addpetpet_Click() lstpetpet.AddItem "" & txtpetpet.Text txtpetpet.Text = "" End Sub Private Sub addspecies_Click() lstspecies.AddItem "" & txtspecies.Text txtspecies.Text = "" End Sub Private Sub addspecific_Click() lstspecific.AddItem "" & txtspecific.Text txtspecific.Text = "" End Sub Private Sub chkstr_Click() If chkstr.Value = 1 Then txtinstr.Enabled = True Else txtinstr.Enabled = False End If End Sub Public Function statsaaer(petname As String, petlev As String, petdef As String, petstr As String) If chkstats.Value = 1 Then If chkin.Value = 1 Then If chklev.Value = 1 Then If petlev >= txtinlev.Text Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If End If If chkstr.Value = 1 Then If petstr >= txtinstr.Text Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If End If If chkdef.Value = 1 Then If petdef >= txtindef.Text Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If End If ElseIf chkde.Value = 1 Then If petlev >= txtdelev.Text And petstr >= txtdestr.Text And petdef >= txtdedef.Text Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If End If End If End Function Public Function coloraaer(petname As String, color As String) For X = 0 To lstcolor.ListCount - 1 If LCase(lstcolor.list(X)) = LCase(color) Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(1, strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(1, strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If Next X End Function Public Function speciesaaer(petname As String, species As String) For X = 0 To lstspecies.ListCount - 1 If LCase(lstspecies.list(X)) = LCase(species) Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(1, strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(1, strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If Next X End Function Public Function specificaaer(petname As String, color As String, species As String) For X = 0 To lstspecific.ListCount - 1 specificcolor = GB(lstspecific.list(X), " Color: ", "]") specificspecies = GB(lstspecific.list(X), "[Species: ", " Color:") If LCase(specificcolor) = LCase(color) And LCase(specificspecies) = LCase(species) Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(1, strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(1, strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If Next X End Function Public Function petpetaaer(petname As String) Dim petpet As String strhtml = w.GetWrapper("http://www.neopets.com/petlookup.phtml?pet=" & petname) If chkmootix.Value = 1 Then If InStr(strhtml, " and its Mootix") Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If End If If InStr(strhtml, "has a Petpet!") Then petpet = GB(strhtml, " has a Petpet!", "hours old") petpet = GB(petpet, "</b> the ", "<") If chklab.Value = 1 And InStr(strhtml, "Zapped by the Petpet Lab Ray") Then Else For X = 0 To lstpetpet.ListCount - 1 If InStr(LCase(petpet), LCase(lstpetpet.list(X))) Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If Next X End If End If End Function Public Function meukaaaer(petname As String) strhtml = w.GetWrapper("http://www.neopets.com/petlookup.phtml?pet=" & petname) If InStr(strhtml, "suffering from <b>Neoflu</b>") Or InStr(strhtml, "suffering from <b>Sneezles</b>") Then strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "You already have four Neopets") Then logs.AddItem "Reached max pets" status = "stop" End If strhtml = w.GetWrapper("http://www.neopets.com/userlookup.phtml?user=" & txtuser.Text) If InStr(strhtml, petname1) Then logs.AddItem "Adopted " & petname Else logs.AddItem "Missed " & petname End If End If End Function Private Sub chkde_Click() If chkde.Value = 1 Then chkin.Value = 0 chklev.Value = 0 chkdef.Value = 0 chkstr.Value = 0 txtdelev.Enabled = True txtdedef.Enabled = True txtdestr.Enabled = True Label12.Enabled = True Label15.Enabled = True Label16.Enabled = True Else txtdelev.Enabled = False txtdedef.Enabled = False txtdestr.Enabled = False Label12.Enabled = False Label15.Enabled = False Label16.Enabled = False End If End Sub Private Sub chkdef_Click() If chkdef.Value = 1 Then txtindef.Enabled = True Else txtindef.Enabled = False End If End Sub Private Sub chkin_Click() If chkin.Value = 1 Then chkde.Value = 0 chklev.Enabled = True chkstr.Enabled = True chkdef.Enabled = True Else chklev.Enabled = False chkstr.Enabled = False chkdef.Enabled = False End If End Sub Private Sub chklev_Click() If chklev.Value = 1 Then txtinlev.Enabled = True Else txtinlev.Enabled = False End If End Sub Private Sub chkstats_Click() If chkstats.Value = 1 Then chkde.Enabled = True chkin.Enabled = True Else chkde.Enabled = False chkin.Enabled = False chklev.Enabled = False chkstr.Enabled = False chkdef.Enabled = False txtdelev.Enabled = False txtdedef.Enabled = False txtdestr.Enabled = False Label12.Enabled = False Label15.Enabled = False Label16.Enabled = False End If End Sub Private Sub clearcolor_Click() lstcolor.Clear End Sub Private Sub clearpetpet_Click() lstpetpet.Clear End Sub Private Sub clearspecies_Click() lstspecies.Clear End Sub Private Sub clearspecifc_Click() End Sub Private Sub clearspecific_Click() lstspecific.Clear End Sub Private Sub cmdlogin_Click() lblstatus.Caption = "Logging in, please wait" strhtml = w.GetWrapper("http://www.neopets.com/index.phtml") strhtml = "" strhtml = w.PostWrapper("http://www.neopets.com/login.phtml", "username=" & txtuser.Text & "&password=" & txtpass.Text & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml") If InStr(strhtml, "badpassword.phtml") Then lblstatus.Caption = "Bad password" ElseIf InStr(strhtml, "petcentral.phtml") Then lblstatus.Caption = "Getting account information." strhtml = w.GetWrapper("http://www.neopets.com/index.phtml") lblaccount.Caption = txtuser.Text If InStr(strhtml, "activePet") Then lblactivepet.Caption = GB(strhtml, "/quickref.phtml" & ChrW$(34) & "><b>", "</b>") Else lblactivepet.Caption = "You have no pet? o.o" End If lblnps.Caption = GB(strhtml, "<a href=" & ChrW$(34) & "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>") lblstatus.Caption = "Logged in" ElseIf InStr(strhtml, "FROZEN") Then lblstatus.Caption = "Your account, " & txtuser.Text & " , is frozen" Else lblstatus.Caption = "Username Doesn't exist or Unknown Error" End If End Sub Private Sub cmdstart_Click() status = "go" strhtml = w.GetWrapper("http://www.neopets.com/pound/index.phtml", "http://www.neopets.com/") Do Until status = "stop" strhtml = w.GetWrapper("http://www.neopets.com/pound/adopt.phtml", "http://www.neopets.com/pound/index.phtml") If InStr(strhtml, "pet_arr[0].name") Then petname1 = GB(strhtml, "pet_arr[0].name = " & ChrW$(34), ChrW$(34)) petspecies1 = GB(strhtml, "pet_arr[0].species = " & ChrW$(34), ChrW$(34)) petcolor1 = GB(strhtml, "pet_arr[0].color = " & ChrW$(34), ChrW$(34)) petlev1 = GB(strhtml, "pet_arr[0].lev = " & ChrW$(34), ChrW$(34)) petstr1 = GB(strhtml, "pet_arr[0].str = " & ChrW$(34), ChrW$(34)) petdef1 = GB(strhtml, "pet_arr[0].def = " & ChrW$(34), ChrW$(34)) lblcurrent.Caption = petname1 If chkspecific = 1 Then specificaaer petname1, petcolor1, petspecies1 End If If chkspecies = 1 Then speciesaaer petname1, petspecies1 End If If chkstatistics = 1 Then statsaaer petname1, petlev1, petdef1, petstr1 End If If chkcolor = 1 Then coloraaer petname1, petcolor1 End If If chkpetpet = 1 Then petpetaaer petname1 End If If chkmeuka.Value = 1 Then meukaaaer petname1 End If End If If InStr(strhtml, "pet_arr[1].name") Then petname2 = GB(strhtml, "pet_arr[1].name = " & ChrW$(34), ChrW$(34)) petspecies2 = GB(strhtml, "pet_arr[1].species = " & ChrW$(34), ChrW$(34)) petcolor2 = GB(strhtml, "pet_arr[1].color = " & ChrW$(34), ChrW$(34)) petlev2 = GB(strhtml, "pet_arr[1].lev = " & ChrW$(34), ChrW$(34)) petstr2 = GB(strhtml, "pet_arr[1].str = " & ChrW$(34), ChrW$(34)) petdef2 = GB(strhtml, "pet_arr[1].def = " & ChrW$(34), ChrW$(34)) lblcurrent.Caption = petname2 If chkspecific = 1 Then specificaaer petname2, petcolor2, petspecies2 End If If chkspecies = 1 Then speciesaaer petname2, petspecies2 End If If chkstatistics = 1 Then statsaaer petname2, petlev2, petdef2, petstr2 End If If chkcolor = 1 Then coloraaer petname2, petcolor2 End If If chkpetpet = 1 Then petpetaaer petname2 End If If chkmeuka.Value = 1 Then meukaaaer petname2 End If End If If InStr(strhtml, "pet_arr[2].name") Then petname3 = GB(strhtml, "pet_arr[2].name = " & ChrW$(34), ChrW$(34)) petspecies3 = GB(strhtml, "pet_arr[2].species = " & ChrW$(34), ChrW$(34)) petcolor3 = GB(strhtml, "pet_arr[2].color = " & ChrW$(34), ChrW$(34)) petlev3 = GB(strhtml, "pet_arr[2].lev = " & ChrW$(34), ChrW$(34)) petstr3 = GB(strhtml, "pet_arr[2].str = " & ChrW$(34), ChrW$(34)) petdef3 = GB(strhtml, "pet_arr[2].def = " & ChrW$(34), ChrW$(34)) lblcurrent.Caption = petname3 If chkspecific = 1 Then specificaaer petname3, petcolor3, petspecies3 End If If chkspecies = 1 Then speciesaaer petname3, petspecies3 End If If chkstatistics = 1 Then statsaaer petname3, petlev3, petdef3, petstr3 End If If chkcolor = 1 Then coloraaer petname3, petcolor3 End If If chkpetpet = 1 Then petpetaaer petname3 End If If chkmeuka.Value = 1 Then meukaaaer petname3 End If End If Loop End Sub Private Sub cmdstop_Click() status = "stop" End Sub Private Sub Image1_Click() MsgBox "You found the secret button. :O Good job." End Sub Private Sub cmdupdate_Click() lblstatus.Caption = "Getting account information." Update = w.GetWrapper("http://www.neopets.com/index.phtml") lblaccount.Caption = txtuser.Text If InStr(Update, "activePet") Then lblactivepet.Caption = GB(Update, "/quickref.phtml" & ChrW$(34) & "><b>", "</b>") Else lblactivepet.Caption = "You have no pet? o.o" End If lblnps.Caption = GB(Update, "<a href=" & ChrW$(34) & "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>") lblstatus.Caption = "Account information updated." 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 Private Sub loadcolor_Click() Call LoadListFromFile(cmdialog1, lstcolor) End Sub Private Sub loadpetpet_Click() Call LoadListFromFile(cmdialog1, lstpetpet) End Sub Private Sub loadspecies_Click() Call LoadListFromFile(cmdialog1, lstspecies) End Sub Private Sub loadspecific_Click() Call LoadListFromFile(cmdialog1, lstspecific) End Sub Private Sub removecolor_Click() If lstcolor.ListIndex > -1 Then lstcolor.RemoveItem lstcolor.ListIndex End If End Sub Private Sub removepetpet_Click() If lstpetpet.ListIndex > -1 Then lstpetpet.RemoveItem lstpetpet.ListIndex End If End Sub Private Sub removespecies_Click() If lstspecies.ListIndex > -1 Then lstspecies.RemoveItem lstspecies.ListIndex End If End Sub Private Sub removespecific_Click() If lstspecific.ListIndex > -1 Then lstspecific.RemoveItem lstspecies.ListIndex End If End Sub Private Sub savecolor_Click() Call SaveListToFile(cmdialog1, lstcolor) End Sub Private Sub savepetpet_Click() Call SaveListToFile(cmdialog1, lstpetpet) End Sub Private Sub savespecies_Click() Call SaveListToFile(cmdialog1, lstspecies) End Sub Private Sub savespecific_Click() Call SaveListToFile(cmdialog1, lstspecific) End Sub frmquick - Code (Text): Dim strhtml As String, refreshed As String, status As String Private Sub cmdlogin_Click() lblloginstats.Caption = "Logging in, please wait" strhtml = w.GetWrapper("http://www.neopets.com/index.phtml") strhtml = w.PostWrapper("http://www.neopets.com/login.phtml", "username=" & user1.Text & "&password=" & pass1.Text & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml") If InStr(strhtml, "badpassword.phtml") Then lblloginstats.Caption = "Idle" ElseIf InStr(strhtml, "petcentral.phtml") Then lblloginstats.Caption = "Logged in" ElseIf InStr(strhtml, "FROZEN") Then lblloginstats.Caption = "Account frozen" Else lblloginstats.Caption = "Username doesn't exist/Guessed too many times/Unknown Error" End If End Sub Private Sub cmdstart_Click() refreshed = "0" lblstatus.Caption = "Refreshed " & refreshed & " times" status = "go" Do Until status = "stop" strhtml = w.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & txtpet.Text, "http://www.neopets.com/pound/adopt.phtml") refreshed = refreshed + 1 lblstatus.Caption = "Refreshed " & refreshed & " times" If InStr(strhtml, "success") Then MsgBox "Pet Adopted" lblstatus.Caption = "Adopted " & txtpet.Text status = "stop" End If If InStr(strhtml, "login to") Then strhtml = w.PostWrapper("http://www.neopets.com/login.phtml", "username=" & user1.Text & "&password=" & pass1.Text & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml") End If Loop End Sub Private Sub cmdstop_Click() status = "stop" End Sub frmselect - Code (Text): 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 Private Sub cmdselect_Click() If Combo1.ListIndex = -1 Then MsgBox "Select a program" ElseIf Combo1.ListIndex = 0 Then Me.Hide frmmain.Show ElseIf Combo1.ListIndex = 1 Then Me.Hide frmquick.Show ElseIf Combo1.ListIndex = 2 Then Me.Hide frmtransfer.Show End If End Sub frmtransfer - Code (Text): Dim petname As String Dim strhtml As String Dim lastatus As String Public Function GB(rC As String, rS As String, rF As String, Optional lgB As Long = 1) As String lgB = InStr(lgB, rC, rS) + Len(rS): GB = Mid$(rC, lgB, InStr(lgB, rC, rF) - lgB) End Function Private Sub cmdlogin1_Click() Label10.Caption = "Logging in, please wait" strhtml = w1.GetWrapper("http://www.neopets.com/index.phtml") strhtml = "" strhtml = w1.PostWrapper("http://www.neopets.com/login.phtml", "username=" & user1.Text & "&password=" & pass1.Text & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml") If InStr(strhtml, "badpassword.phtml") Then MsgBox "Bad password" Label10.Caption = "Idle" ElseIf InStr(strhtml, "petcentral.phtml") Then MsgBox "Logged in as " & user1.Text Label10.Caption = "Logged in" ElseIf InStr(strhtml, "FROZEN") Then MsgBox "Your account," & user1.Text & ", is frozen" Label10.Caption = "Idle" Else MsgBox "Username Doesn't exist or Unknown Error" End If End Sub Private Sub cmdlogin2_Click() Label11.Caption = "Logging in, please wait" strhtml = w2.GetWrapper("http://www.neopets.com/index.phtml") strhtml = "" strhtml = w2.PostWrapper("http://www.neopets.com/login.phtml", "username=" & user2.Text & "&password=" & pass2.Text & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml") If InStr(strhtml, "badpassword.phtml") Then MsgBox "Bad password" Label11.Caption = "Idle" ElseIf InStr(strhtml, "petcentral.phtml") Then MsgBox "Logged in as " & user2.Text Label11.Caption = "Logged in" ElseIf InStr(strhtml, "FROZEN") Then MsgBox "Your account," & user2.Text & ", is frozen" Label11.Caption = "Idle" Else MsgBox "Username Doesn't exist or Unknown Error" End If End Sub Private Sub transfer_Click() lastatus = "go" petname = thename.Text pin = txtpin.Text log1.AddItem "Transfering " & petname strhtml = w2.GetWrapper("http://www.neopets.com/pound/abandon.phtml") confirm = GB(strhtml, "<input type='hidden' name='_ref_ck' value='", "'>") strhtml = w2.PostWrapper("http://www.neopets.com/pound/process_abandon.phtml", "pet_name=" & petname & "&confirm=4&_ref_ck=" & confirm & "&pin=" & pin, "http://www.neopets.com/pound/abandon.phtml") strhtml = w1.PostWrapper("http://www.neopets.com/pound/process_adopt.phtml", "pet_name=" & petname, "http://www.neopets.com/pound/adopt.phtml") If InStr(strhtml, "success") Then log1.AddItem "Transfer Success" Else log1.AddItem "Transfer failed?" End If End Sub