Josh
07-13-2013, 03:17 AM
Not the entire thing, but the important parts (Didnt include all list crap, since thats simple)
Public Shared Function neologin(ByVal user As String, ByVal pass As String)
SetUA("Mozilla/5.0 (Windows NT 6.2; rv:21.0) Gecko/20100101 Firefox/21.0")
Dim strhtml As String
strhtml = Req("GET", "[Only registered and activated users can see links]", "")
strhtml = Req("POST", "[Only registered and activated users can see links]" & user & "&password=" & pass, "[Only registered and activated users can see links]")
If InStr(strhtml, "Welcome,") Then
Return True
Else
Return False
End If
End Function
Public Function petpetcheck(ByVal petname As String)
Dim petattached As String, checkpp As Boolean
strhtml = Req("GET", "[Only registered and activated users can see links]" & petname, "")
If InStr(strhtml, "</b> has a Petpet!") Then
petattached = GetBetween(strhtml, "</b> has a Petpet!<br /><br /><img ", "</div></")
For x As Integer = 0 To lstpp.Items.Count - 1
If InStr(LCase(petattached), LCase(lstpp.Items(x))) Then
checkpp = True
Exit For
End If
Next x
If chkmootix.Checked = True Then
If InStr(strhtml, " and its <b>Mootix</b>") Then
checkpp = True
End If
End If
If checkpp = True Then
Return True
Else
Return False
End If
Else
Return False
End If
End Function
Public Function colorcheck(ByVal color As String)
Dim checkc As Boolean
For x As Integer = 0 To lstcolor.Items.Count - 1
If LCase(lstcolor.Items.Item(x)) = LCase(color) Then
checkc = True
Exit For
End If
Next x
If checkc = True Then
Return True
Else
Return False
End If
End Function
Public Function checkstats(ByVal lev As Integer, ByVal str As Integer, ByVal def As Integer)
Dim checkl As Boolean, checkd As Boolean, checkstr As Boolean
If chklev.Checked = True Then
If lev > Integer.Parse(txtlev.Text) Then
checkl = True
Else
checkl = False
End If
Else
checkl = True
End If
If chkstr.Checked = True Then
If str > Integer.Parse(txtstr.Text) Then
checkstr = True
Else
checkstr = False
End If
Else
checkstr = True
End If
If chkdef.Checked = True Then
If def > Integer.Parse(txtdef.Text) Then
checkd = True
Else
checkd = False
End If
Else
checkd = True
End If
If checkl = True And checkd = True And checkstr = True Then
Return True
Else
Return False
End If
End Function
Public Function speciescheck(ByVal spec As String)
Dim checks As Boolean
For x As Integer = 0 To lstspec.Items.Count - 1
If LCase(lstspec.Items.Item(x)) = LCase(spec) Then
checks = True
Exit For
End If
Next x
If checks = True Then
Return True
Else
Return False
End If
End Function
Public Function specificcheck(ByVal color As String, ByRef spec As String)
Dim checks As Boolean
Dim speccolor, specspec
For x As Integer = 0 To lstspecific.Items.Count - 1
speccolor = GetBetween(lstspecific.Items.Item(x), "Color: ", " Species:")
specspec = GetBetween(lstspecific.Items.Item(x) & "!", "Species: ", "!")
If LCase(specspec) = LCase(spec) And LCase(speccolor) = LCase(color) Then
checks = True
Exit For
End If
Next x
If checks = True Then
Return True
Else
Return False
End If
End Function
Public Function adopt(ByVal pet As String)
If InStr(Req("POST", "[Only registered and activated users can see links]" & pet, "[Only registered and activated users can see links]"), "success") Then
Setaddlist_ThreadSafe(logs, "Adopted " & pet)
Else
Setaddlist_ThreadSafe(logs, "Missed " & pet)
End If
Return "done"
End Function
Do While runprogram = True
If runprogram = False Then
BackgroundWorker1.CancelAsync()
Else
'Start of adopter
strhtml = Req("GET", "[Only registered and activated users can see links]", "[Only registered and activated users can see links]")
If strhtml.Contains("Log In!") Then
neologin(txtneou.Text, txtneop.Text)
strhtml = Req("GET", "[Only registered and activated users can see links]", "[Only registered and activated users can see links]")
End If
'Start get values
If strhtml.Contains("pet_arr[0].name") Then
petname1 = GetBetween(strhtml, "pet_arr[0].name = " & ChrW(34), ChrW(34) & ";")
petcolor1 = GetBetween(strhtml, "pet_arr[0].color = " & ChrW(34), ChrW(34) & ";")
petspec1 = GetBetween(strhtml, "pet_arr[0].species = " & ChrW(34), ChrW(34) & ";")
petlev1 = GetBetween(strhtml, "pet_arr[0].level = " & ChrW(34), ChrW(34) & ";")
petstr1 = GetBetween(strhtml, "pet_arr[0].str = " & ChrW(34), ChrW(34) & ";")
petdef1 = GetBetween(strhtml, "pet_arr[0].def = " & ChrW(34), ChrW(34) & ";")
End If
If strhtml.Contains("pet_arr[1].name") Then
petname2 = GetBetween(strhtml, "pet_arr[1].name = " & ChrW(34), ChrW(34) & ";")
petcolor2 = GetBetween(strhtml, "pet_arr[1].color = " & ChrW(34), ChrW(34) & ";")
petspec2 = GetBetween(strhtml, "pet_arr[1].species = " & ChrW(34), ChrW(34) & ";")
petlev2 = GetBetween(strhtml, "pet_arr[1].level = " & ChrW(34), ChrW(34) & ";")
petstr2 = GetBetween(strhtml, "pet_arr[1].str = " & ChrW(34), ChrW(34) & ";")
petdef2 = GetBetween(strhtml, "pet_arr[1].def = " & ChrW(34), ChrW(34) & ";")
End If
If strhtml.Contains("pet_arr[2].name") Then
petname3 = GetBetween(strhtml, "pet_arr[2].name = " & ChrW(34), ChrW(34) & ";")
petcolor3 = GetBetween(strhtml, "pet_arr[2].color = " & ChrW(34), ChrW(34) & ";")
petspec3 = GetBetween(strhtml, "pet_arr[2].species = " & ChrW(34), ChrW(34) & ";")
petlev3 = GetBetween(strhtml, "pet_arr[2].level = " & ChrW(34), ChrW(34) & ";")
petstr3 = GetBetween(strhtml, "pet_arr[2].str = " & ChrW(34), ChrW(34) & ";")
petdef3 = GetBetween(strhtml, "pet_arr[2].def = " & ChrW(34), ChrW(34) & ";")
End If
'End get values. Start checking if pet should be adopted
'Color
If chkc.Checked = True Then
If colorcheck(petcolor1) = True Then
adopt(petname1)
End If
If colorcheck(petcolor2) = True Then
adopt(petname2)
End If
If colorcheck(petcolor3) = True Then
adopt(petname3)
End If
End If
'Species
If chk2.Checked = True Then
If speciescheck(petspec1) = True Then
adopt(petname1)
End If
If speciescheck(petspec2) = True Then
adopt(petname2)
End If
If speciescheck(petspec3) = True Then
adopt(petname3)
End If
End If
'Specific
If chk3.Checked = True Then
If specificcheck(petcolor1, petspec1) = True Then
adopt(petname1)
End If
If specificcheck(petcolor2, petspec2) = True Then
adopt(petname2)
End If
If specificcheck(petcolor3, petspec3) = True Then
adopt(petname3)
End If
End If
'Petpet
If chkpetpet.Checked = True Then
If petpetcheck(petname1) = True Then
adopt(petname1)
End If
If petpetcheck(petname2) = True Then
adopt(petname2)
End If
If petpetcheck(petname3) = True Then
adopt(petname3)
End If
End If
'Stats
If chkstats.Checked = True Then
If petlev1 = "" Then
petlev1 = "0"
petstr1 = "0"
petdef1 = "0"
End If
If petlev2 = "" Then
petlev2 = "0"
petstr2 = "0"
petdef2 = "0"
End If
If petlev3 = "" Then
petlev3 = "0"
petstr3 = "0"
petdef3 = "0"
End If
If checkstats(Integer.Parse(petlev1), Integer.Parse(petstr1), Integer.Parse(petdef1)) = True Then
adopt(petname1)
End If
If checkstats(Integer.Parse(petlev2), Integer.Parse(petstr2), Integer.Parse(petdef2)) = True Then
adopt(petname2)
End If
If checkstats(Integer.Parse(petlev3), Integer.Parse(petstr3), Integer.Parse(petdef3)) = True Then
adopt(petname3)
End If
End If
wait = Integer.Parse(GetRandom(Integer.Parse(txtwait1.Tex t.ToString), Integer.Parse(txtwait2.Text.ToString)))
SetLabelText_ThreadSafe(lblstatus, "Waiting " & wait & " ms")
System.Threading.Thread.Sleep(wait)
End If
Loop
SetLabelText_ThreadSafe(lblstatus, "Stopped")
BackgroundWorker1.CancelAsync()
Public Shared Function neologin(ByVal user As String, ByVal pass As String)
SetUA("Mozilla/5.0 (Windows NT 6.2; rv:21.0) Gecko/20100101 Firefox/21.0")
Dim strhtml As String
strhtml = Req("GET", "[Only registered and activated users can see links]", "")
strhtml = Req("POST", "[Only registered and activated users can see links]" & user & "&password=" & pass, "[Only registered and activated users can see links]")
If InStr(strhtml, "Welcome,") Then
Return True
Else
Return False
End If
End Function
Public Function petpetcheck(ByVal petname As String)
Dim petattached As String, checkpp As Boolean
strhtml = Req("GET", "[Only registered and activated users can see links]" & petname, "")
If InStr(strhtml, "</b> has a Petpet!") Then
petattached = GetBetween(strhtml, "</b> has a Petpet!<br /><br /><img ", "</div></")
For x As Integer = 0 To lstpp.Items.Count - 1
If InStr(LCase(petattached), LCase(lstpp.Items(x))) Then
checkpp = True
Exit For
End If
Next x
If chkmootix.Checked = True Then
If InStr(strhtml, " and its <b>Mootix</b>") Then
checkpp = True
End If
End If
If checkpp = True Then
Return True
Else
Return False
End If
Else
Return False
End If
End Function
Public Function colorcheck(ByVal color As String)
Dim checkc As Boolean
For x As Integer = 0 To lstcolor.Items.Count - 1
If LCase(lstcolor.Items.Item(x)) = LCase(color) Then
checkc = True
Exit For
End If
Next x
If checkc = True Then
Return True
Else
Return False
End If
End Function
Public Function checkstats(ByVal lev As Integer, ByVal str As Integer, ByVal def As Integer)
Dim checkl As Boolean, checkd As Boolean, checkstr As Boolean
If chklev.Checked = True Then
If lev > Integer.Parse(txtlev.Text) Then
checkl = True
Else
checkl = False
End If
Else
checkl = True
End If
If chkstr.Checked = True Then
If str > Integer.Parse(txtstr.Text) Then
checkstr = True
Else
checkstr = False
End If
Else
checkstr = True
End If
If chkdef.Checked = True Then
If def > Integer.Parse(txtdef.Text) Then
checkd = True
Else
checkd = False
End If
Else
checkd = True
End If
If checkl = True And checkd = True And checkstr = True Then
Return True
Else
Return False
End If
End Function
Public Function speciescheck(ByVal spec As String)
Dim checks As Boolean
For x As Integer = 0 To lstspec.Items.Count - 1
If LCase(lstspec.Items.Item(x)) = LCase(spec) Then
checks = True
Exit For
End If
Next x
If checks = True Then
Return True
Else
Return False
End If
End Function
Public Function specificcheck(ByVal color As String, ByRef spec As String)
Dim checks As Boolean
Dim speccolor, specspec
For x As Integer = 0 To lstspecific.Items.Count - 1
speccolor = GetBetween(lstspecific.Items.Item(x), "Color: ", " Species:")
specspec = GetBetween(lstspecific.Items.Item(x) & "!", "Species: ", "!")
If LCase(specspec) = LCase(spec) And LCase(speccolor) = LCase(color) Then
checks = True
Exit For
End If
Next x
If checks = True Then
Return True
Else
Return False
End If
End Function
Public Function adopt(ByVal pet As String)
If InStr(Req("POST", "[Only registered and activated users can see links]" & pet, "[Only registered and activated users can see links]"), "success") Then
Setaddlist_ThreadSafe(logs, "Adopted " & pet)
Else
Setaddlist_ThreadSafe(logs, "Missed " & pet)
End If
Return "done"
End Function
Do While runprogram = True
If runprogram = False Then
BackgroundWorker1.CancelAsync()
Else
'Start of adopter
strhtml = Req("GET", "[Only registered and activated users can see links]", "[Only registered and activated users can see links]")
If strhtml.Contains("Log In!") Then
neologin(txtneou.Text, txtneop.Text)
strhtml = Req("GET", "[Only registered and activated users can see links]", "[Only registered and activated users can see links]")
End If
'Start get values
If strhtml.Contains("pet_arr[0].name") Then
petname1 = GetBetween(strhtml, "pet_arr[0].name = " & ChrW(34), ChrW(34) & ";")
petcolor1 = GetBetween(strhtml, "pet_arr[0].color = " & ChrW(34), ChrW(34) & ";")
petspec1 = GetBetween(strhtml, "pet_arr[0].species = " & ChrW(34), ChrW(34) & ";")
petlev1 = GetBetween(strhtml, "pet_arr[0].level = " & ChrW(34), ChrW(34) & ";")
petstr1 = GetBetween(strhtml, "pet_arr[0].str = " & ChrW(34), ChrW(34) & ";")
petdef1 = GetBetween(strhtml, "pet_arr[0].def = " & ChrW(34), ChrW(34) & ";")
End If
If strhtml.Contains("pet_arr[1].name") Then
petname2 = GetBetween(strhtml, "pet_arr[1].name = " & ChrW(34), ChrW(34) & ";")
petcolor2 = GetBetween(strhtml, "pet_arr[1].color = " & ChrW(34), ChrW(34) & ";")
petspec2 = GetBetween(strhtml, "pet_arr[1].species = " & ChrW(34), ChrW(34) & ";")
petlev2 = GetBetween(strhtml, "pet_arr[1].level = " & ChrW(34), ChrW(34) & ";")
petstr2 = GetBetween(strhtml, "pet_arr[1].str = " & ChrW(34), ChrW(34) & ";")
petdef2 = GetBetween(strhtml, "pet_arr[1].def = " & ChrW(34), ChrW(34) & ";")
End If
If strhtml.Contains("pet_arr[2].name") Then
petname3 = GetBetween(strhtml, "pet_arr[2].name = " & ChrW(34), ChrW(34) & ";")
petcolor3 = GetBetween(strhtml, "pet_arr[2].color = " & ChrW(34), ChrW(34) & ";")
petspec3 = GetBetween(strhtml, "pet_arr[2].species = " & ChrW(34), ChrW(34) & ";")
petlev3 = GetBetween(strhtml, "pet_arr[2].level = " & ChrW(34), ChrW(34) & ";")
petstr3 = GetBetween(strhtml, "pet_arr[2].str = " & ChrW(34), ChrW(34) & ";")
petdef3 = GetBetween(strhtml, "pet_arr[2].def = " & ChrW(34), ChrW(34) & ";")
End If
'End get values. Start checking if pet should be adopted
'Color
If chkc.Checked = True Then
If colorcheck(petcolor1) = True Then
adopt(petname1)
End If
If colorcheck(petcolor2) = True Then
adopt(petname2)
End If
If colorcheck(petcolor3) = True Then
adopt(petname3)
End If
End If
'Species
If chk2.Checked = True Then
If speciescheck(petspec1) = True Then
adopt(petname1)
End If
If speciescheck(petspec2) = True Then
adopt(petname2)
End If
If speciescheck(petspec3) = True Then
adopt(petname3)
End If
End If
'Specific
If chk3.Checked = True Then
If specificcheck(petcolor1, petspec1) = True Then
adopt(petname1)
End If
If specificcheck(petcolor2, petspec2) = True Then
adopt(petname2)
End If
If specificcheck(petcolor3, petspec3) = True Then
adopt(petname3)
End If
End If
'Petpet
If chkpetpet.Checked = True Then
If petpetcheck(petname1) = True Then
adopt(petname1)
End If
If petpetcheck(petname2) = True Then
adopt(petname2)
End If
If petpetcheck(petname3) = True Then
adopt(petname3)
End If
End If
'Stats
If chkstats.Checked = True Then
If petlev1 = "" Then
petlev1 = "0"
petstr1 = "0"
petdef1 = "0"
End If
If petlev2 = "" Then
petlev2 = "0"
petstr2 = "0"
petdef2 = "0"
End If
If petlev3 = "" Then
petlev3 = "0"
petstr3 = "0"
petdef3 = "0"
End If
If checkstats(Integer.Parse(petlev1), Integer.Parse(petstr1), Integer.Parse(petdef1)) = True Then
adopt(petname1)
End If
If checkstats(Integer.Parse(petlev2), Integer.Parse(petstr2), Integer.Parse(petdef2)) = True Then
adopt(petname2)
End If
If checkstats(Integer.Parse(petlev3), Integer.Parse(petstr3), Integer.Parse(petdef3)) = True Then
adopt(petname3)
End If
End If
wait = Integer.Parse(GetRandom(Integer.Parse(txtwait1.Tex t.ToString), Integer.Parse(txtwait2.Text.ToString)))
SetLabelText_ThreadSafe(lblstatus, "Waiting " & wait & " ms")
System.Threading.Thread.Sleep(wait)
End If
Loop
SetLabelText_ThreadSafe(lblstatus, "Stopped")
BackgroundWorker1.CancelAsync()