Reemer
10-29-2018, 02:58 PM
This is like 7 years old, before I even started (and finished) my computer engineering degree. Don't judge for how bad it is.:rolleyes:
It was copied from my SDB checker, hence the name. I don't think this was the version that was released. I can't find that source.
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Begin VB.Form frmchecker
Caption = "Reemer's SDB Checker"
ClientHeight = 6675
ClientLeft = 2685
ClientTop = 2085
ClientWidth = 7815
Icon = "checker.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6675
ScaleWidth = 7815
Begin VB.ListBox lstmove
Height = 645
Left = 4920
TabIndex = 29
Top = 5760
Width = 615
End
Begin VB.ListBox lstdefence
Height = 645
Left = 4200
TabIndex = 28
Top = 5760
Width = 615
End
Begin VB.ListBox lststrength
Height = 645
Left = 3480
TabIndex = 27
Top = 5760
Width = 615
End
Begin VB.ListBox lsthealth
Height = 645
Left = 2640
TabIndex = 26
Top = 5760
Width = 735
End
Begin VB.ListBox lstlvl
Height = 645
Left = 1800
TabIndex = 25
Top = 5760
Width = 735
End
Begin VB.ListBox lstcolour
Height = 645
Left = 960
TabIndex = 24
Top = 5760
Width = 735
End
Begin VB.ListBox lstspecies
Height = 645
Left = 120
TabIndex = 23
Top = 5760
Width = 735
End
Begin VB.ListBox lstGBA
Height = 840
Left = 120
TabIndex = 22
Top = 2280
Width = 1215
End
Begin VB.TextBox txtproxy
Height = 285
Left = 1200
TabIndex = 21
Text = "host:port"
Top = 5040
Width = 1215
End
Begin VB.CheckBox chkProxy
Caption = "Use Proxy"
Height = 255
Left = 0
TabIndex = 20
Top = 5040
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "Test Proxy"
Height = 255
Left = 2640
TabIndex = 19
Top = 5040
Width = 1095
End
Begin VB.CheckBox chkproglog
Caption = "Save as ProgLog.txt upon closure"
Height = 255
Left = 5040
TabIndex = 18
Top = 5400
Value = 1 'Checked
Width = 2775
End
Begin VB.TextBox txtsave
Height = 285
Left = 6840
TabIndex = 16
Text = "ProgLog"
Top = 4920
Width = 855
End
Begin VB.CommandButton cmdclearitems
Caption = "Clear"
Height = 255
Left = 2040
TabIndex = 13
Top = 4200
Width = 735
End
Begin VB.CommandButton cmdloaditems
Caption = "Load"
Height = 255
Left = 1080
TabIndex = 12
Top = 4200
Width = 855
End
Begin VB.CommandButton cmdSave
Caption = "Save log"
Height = 315
Left = 6600
TabIndex = 11
Top = 4560
Width = 1095
End
Begin MSComDlg.CommonDialog CD
Left = 4200
Top = 5040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdclear
Caption = "Clear"
Height = 255
Left = 1920
TabIndex = 10
Top = 1920
Width = 735
End
Begin VB.CommandButton cmdload
Caption = "Load"
Height = 255
Left = 1080
TabIndex = 9
Top = 1920
Width = 735
End
Begin VB.ListBox lstaccounts
Height = 1425
ItemData = "checker.frx":FE51
Left = 240
List = "checker.frx":FE53
TabIndex = 8
Top = 360
Width = 2415
End
Begin Project1.ctlRipperWrapper RipperWrapper
Left = 4320
Top = 4800
_ExtentX = 847
_ExtentY = 847
GZip = 0 'False
Timeout = 8000
End
Begin VB.ListBox lststatus
Height = 3960
Left = 3000
TabIndex = 7
Top = 360
Width = 4575
End
Begin VB.TextBox txtwait2
Height = 285
Left = 2040
TabIndex = 5
Text = "1000"
Top = 5400
Width = 495
End
Begin VB.TextBox txtwait1
Height = 285
Left = 1080
TabIndex = 4
Text = "500"
Top = 5400
Width = 495
End
Begin VB.CommandButton cmdstop
Caption = "Stop"
Height = 375
Left = 1080
TabIndex = 1
Top = 4560
Width = 975
End
Begin VB.CommandButton cmdStart
Caption = "Start"
Height = 375
Left = 0
TabIndex = 0
Top = 4560
Width = 975
End
Begin VB.Frame Frame2
Caption = "Log"
Height = 4335
Left = 2880
TabIndex = 14
Top = 120
Width = 4815
End
Begin VB.Frame Frame3
Caption = "Accounts"
Height = 1815
Left = 120
TabIndex = 15
Top = 120
Width = 2655
End
Begin VB.Label Label1
Caption = "Save log as"
Height = 255
Left = 5880
TabIndex = 17
Top = 4920
Width = 855
End
Begin VB.Label Label3
Caption = "ms between refreshes"
Height = 255
Left = 2640
TabIndex = 6
Top = 5400
Width = 1575
End
Begin VB.Label Label2
Caption = "Wait between and"
Height = 255
Left = 0
TabIndex = 3
Top = 5400
Width = 1935
End
Begin VB.Label lblstatus
Caption = "Status"
Height = 255
Left = 2280
TabIndex = 2
Top = 4680
Width = 3495
End
End
Attribute VB_Name = "frmchecker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strHTML As String
Dim strprocess As String
Dim StopProgram As Boolean
Dim strMyNeopoints As String
Dim strlocation As String
Dim host As String
Dim port As String
Dim Retry As Boolean
Public Function GBA(ByVal Str As String, start As String, Finish As String, lstAdd As ListBox, Optional Clear As Boolean = True, Optional lgB As Long = 1) As String
On Error Resume Next
If Clear = True Then lstAdd.Clear
Do Until lgB <= lngStop
lgB = InStr(lgB, Str, start)
If lgB + Len(start) >= Len(Str) Or lgB = 0 Then Exit Function
If lgB <> 0 Then lgB = lgB + Len(start): GBA = Mid$(Str, lgB, InStr(lgB, Str, Finish) - lgB): lgB = lgB + 1
lstAdd.AddItem GBA
Loop
End Function
Public Function GetStringBetween(ByVal InputText As String, _
ByVal StartText As String, _
ByVal EndText As String, _
Optional ByVal StartPosition = 1) As String
Dim lnTextStart As Long
Dim lnTextEnd As Long
lnTextStart = InStr(StartPosition, InputText, StartText, vbTextCompare) + Len(StartText)
lnTextEnd = InStr(lnTextStart, InputText, EndText, vbTextCompare)
If lnTextStart >= (StartPosition + Len(StartText)) And lnTextEnd > lnTextStart Then
GetStringBetween = Mid$(InputText, lnTextStart, lnTextEnd - lnTextStart)
Else
GetStringBetween = ""
End If
End Function
Public Function Rand(ByVal Low As Long, _
ByVal High As Long) As Long
Randomize
Rand = Int((High - Low + 1) * Rnd) + Low
End Function
Private Sub cmdclear_Click()
lstaccounts.Clear
End Sub
Private Sub cmdclearitems_Click()
lstitems.Clear
End Sub
Private Sub cmdload_Click()
Dim strFile As String
strFile = SelectFileToLoad(CD)
If Len(strFile) > 1 Then
Call FileModule.TextFileToList(strFile, lstaccounts)
Else
MsgBox ("No file was loaded!")
End If
End Sub
Private Sub cmdloaditems_Click()
Dim strFile As String
strFile = SelectFileToLoad(CD)
If Len(strFile) > 1 Then
Call FileModule.TextFileToList(strFile, lstitems)
Else
MsgBox ("No file was loaded!")
End If
End Sub
Private Sub cmdSave_Click()
Call saveList(lststatus, App.Path & "\" & txtsave.Text & ".txt", "Append")
End Sub
Private Sub cmdStart_Click()
Dim stritem As String
Dim strunique As String
Dim strqty As String
Dim strcheck As String
Dim strTotalNP As String
cmdStart.Enabled = False
cmdstop.Enabled = True
StopProgram = False
If StopProgram = False Then
For X = 0 To lstaccounts.ListCount - 1
strTotalNP = 0
If StopProgram = False Then
lststatus.AddItem ("=====================================")
End If
stringtosplit = lstaccounts.List(X)
temp = Split(stringtosplit, ":")
'temp(0) = user
user = temp(0)
'temp(1) = pass
pass = temp(1)
stringtosplit = txtproxy.Text
temp = Split(stringtosplit, ":")
'temp(0) = user
host = temp(0)
'temp(1) = pass
port = temp(1)
If chkProxy.Value = 1 Then
Call RipperWrapper.SetProxy("" & host, "" & port)
End If
If StopProgram = False Then
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
lblstatus.Caption = "Logging in."
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "POST", "[Only registered and activated users can see links]" & user & "&password=" & pass & "&destination=%2petcentral.phtml/")
If InStr(1, strHTML, "badpassword") Then
lststatus.AddItem ("Account " & user & "had the wrong password.")
lblstatus.Caption = "Invalid Password/Username"
ElseIf InStr(1, strHTML, "This account has been") Then
lststatus.AddItem ("Account " & user & "has been frozen.")
lblstatus.Caption = "Sorry, This Account Has Been Frozen"
ElseIf InStr(1, strHTML, "Update Account") Then
lststatus.AddItem ("Account " & user & " needs to be updated.")
lblstatus.Caption = "Sorry, This Account Has Been Lawyerbotted"
ElseIf InStr(1, strHTML, "It looks like you haven't logged in for a while") Then
lststatus.AddItem ("Account " & user & " needs to be Bday cracked.")
lblstatus.Caption = "Sorry, This Account Hasn't Been Logged in"
ElseIf InStr(1, strHTML, "petcentral") Then
lblstatus.Caption = "Successfully logged in."
End If
If chkProxy.Value = 1 Then
Call RipperWrapper.NoProxy
End If
If StopProgram = False Then
lststatus.AddItem ("Checking account: " & user)
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]" & user)
'vbKeyTab is for tabs
strcheck = GetStringBetween(strHTML, "<b>Secret Avatars:</b><br />", "<br /><br /><br />")
strcheck = Replace(strcheck, vbKeyTab, "")
lststatus.AddItem ("Account has " & strcheck & " avatars.")
strcheck = GetStringBetween(strHTML, "<b>Stamps:</b><br />", "<br /><br />")
strcheck = Replace(strcheck, vbKeyTab, "")
lststatus.AddItem ("Account has " & strcheck & " stamps.")
strcheck = GetStringBetween(strHTML, "<b>Site Themes:</b><br />", "</td>")
strcheck = Replace(strcheck, vbKeyTab, "")
lststatus.AddItem ("Account has " & strcheck & " site themes.")
Call GBA(strHTML, "[Only registered and activated users can see links]", ".gif", lstGBA)
lststatus.AddItem (" Account has " & lstGBA.ListCount & " trophies.")
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
lblstatus.Caption = "Checking Bank."
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strcheck = GetStringBetween(strHTML, "<td align=""center"" style=""font-weight: bold;"">", " NP</td>")
lststatus.AddItem ("Account has " & strcheck & " NP in bank.")
strMyNeopoints = GetStringBetween(strHTML, "objects.phtml?type=inventory"">", "</a>")
lststatus.AddItem ("Account has " & strMyNeopoints & " NP on hand.")
strcheck = Replace(strcheck, ",", "")
strMyNeopoints = Replace(strMyNeopoints, ",", "")
strTotalNP = Val(strTotalNP) + Val(strMyNeopoints) + Val(strcheck)
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strcheck = GetStringBetween(strHTML, "Items:</b> ", " | <b>Qty:</b>")
strqty = GetStringBetween(strHTML, " | <b>Qty:</b>", vbNewLine)
lststatus.AddItem ("Account has " & strcheck & " unique items and " & strqty & " total items in SDB.")
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strcheck = GetStringBetween(strHTML, "<b>Items:</b> ", " | <b>Qty:</b>")
strqty = GetStringBetween(strHTML, " | <b>Qty:</b>", " | <b>Page:</b>")
lststatus.AddItem ("Account has " & strcheck & " unique items and " & strqty & " total items in closet.")
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
lststatus.AddItem ("Now checking pets.")
If InStr(strHTML, "must be converted in order to be fully customisable.") Then
lststatus.AddItem ("Account has unconverted pets!!")
End If
Call GBA(strHTML, "Species:</th><td class='sf'><b>", "</b></td></tr>", lstspecies)
Call GBA(strHTML, "Colour:</th><td class='sf'><b>", "</b></td></tr>", lstcolour)
Call GBA(strHTML, "Level:</th><td class='sf'><b>", "</b></td></tr>", lstlvl)
Call GBA(strHTML, " / ", "</b>", lsthealth)
Call GBA(strHTML, "Strength:</th><td class='sf'><b>", "</b></td></tr>", lststrength)
Call GBA(strHTML, "Defence:</th><td class='sf'><b>", "</b></td></tr>", lstdefence)
Call GBA(strHTML, "Move:</th><td class='sf'><b>", "</b></td></tr>", lstmove)
For i = 0 To lstspecies.ListCount - 1
lststatus.AddItem ("Pet #" & i & " statistics:")
lststatus.AddItem ("Species: " & lstspecies.List(i))
lststatus.AddItem ("Colour: " & lstcolour.List(i))
lststatus.AddItem ("Level: " & lstlvl.List(i))
lststatus.AddItem ("Max Health: " & lsthealth.List(i))
lststatus.AddItem ("Strength: " & lststrength.List(i))
lststatus.AddItem ("Defence: " & lstdefence.List(i))
lststatus.AddItem ("Move: " & lstmove.List(i))
lststatus.AddItem ("------------------------")
Next i
lstspecies.Clear
lstcolour.Clear
lstlvl.Clear
lsthealth.Clear
lststrength.Clear
lstdefence.Clear
lstmove.Clear
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
lststatus.AddItem ("Account has " & strTotalNP & " total NP.")
End If
Else
If StopProgram = False Then
lblstatus.Caption = "Error is Unknown"
lststatus.AddItem ("Account " & user & "has an unknown error.")
End If
End If
Next X
End If
lblstatus.Caption = "Idle..."
End Sub
Private Sub cmdstop_Click()
StopProgram = True
lblstatus.Caption = "Stopped."
cmdStart.Enabled = True
cmdstop.Enabled = False
End Sub
Private Sub Command1_Click()
stringtosplit = txtproxy.Text
temp = Split(stringtosplit, ":")
'temp(0) = user
host = temp(0)
'temp(1) = pass
port = temp(1)
If chkProxy.Value = 1 Then
Call RipperWrapper.SetProxy("" & host, "" & port)
End If
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strHTML = GetStringBetween(strHTML, "Your visible IP address: ", "</h1><h3>")
MsgBox ("Proxy IP is: " & strHTML)
Call RipperWrapper.NoProxy
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strHTML = GetStringBetween(strHTML, "Your visible IP address: ", "</h1><h3>")
MsgBox ("Regular IP is: " & strHTML & vbNewLine & "(c) [Only registered and activated users can see links]")
End Sub
Private Sub Command2_Click()
Dim nowdate As Date
txtsave.Text = DateValue(Now)
txtsave.Text = Replace(txtsave.Text, "/", "-")
End Sub
Private Sub Form_Load()
txtsave.Text = DateValue(Now)
txtsave.Text = Replace(txtsave.Text, "/", "-")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call saveList(lststatus, App.Path & "\ProgLog.txt", "Append")
Dim frm As Form
For Each frm In Forms
Unload frm
Next
End Sub
Private Sub txtproxy_Click()
txtproxy.Text = ""
End Sub
Here's some good links that might not be in the source:
Bank [Only registered and activated users can see links] **
Safety Deposit Box [Only registered and activated users can see links]
Closet [Only registered and activated users can see links]
Petpets [Only registered and activated users can see links]
Battledome [Only registered and activated users can see links]
Neocash Items [Only registered and activated users can see links]
Inventory [Only registered and activated users can see links]
Shop [Only registered and activated users can see links]
Shop Till [Only registered and activated users can see links]
Gallery [Only registered and activated users can see links]
Neodeck [Only registered and activated users can see links]
Stock Market [Only registered and activated users can see links]
Storage Shed [Only registered and activated users can see links]
Neohome Items [Only registered and activated users can see links]
Neggery [Only registered and activated users can see links]
Laboratory [Only registered and activated users can see links]
Keyquest [Only registered and activated users can see links]
Rainbow Fountain (FFQ) [Only registered and activated users can see links]
World Challenge [Only registered and activated users can see links]
TCG Album [Only registered and activated users can see links]
Unused Plot Points (Return of Sloth) [Only registered and activated users can see links]
Unused Plot Points (Tale of Woe) [Only registered and activated users can see links]
Unused Plot Points (Lost Desert) [Only registered and activated users can see links]
Unused Plot Points (Altador Cup) [Only registered and activated users can see links]
Unused Plot Points (The Faeries' Ruin)[Only registered and activated users can see links]
It was copied from my SDB checker, hence the name. I don't think this was the version that was released. I can't find that source.
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Begin VB.Form frmchecker
Caption = "Reemer's SDB Checker"
ClientHeight = 6675
ClientLeft = 2685
ClientTop = 2085
ClientWidth = 7815
Icon = "checker.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6675
ScaleWidth = 7815
Begin VB.ListBox lstmove
Height = 645
Left = 4920
TabIndex = 29
Top = 5760
Width = 615
End
Begin VB.ListBox lstdefence
Height = 645
Left = 4200
TabIndex = 28
Top = 5760
Width = 615
End
Begin VB.ListBox lststrength
Height = 645
Left = 3480
TabIndex = 27
Top = 5760
Width = 615
End
Begin VB.ListBox lsthealth
Height = 645
Left = 2640
TabIndex = 26
Top = 5760
Width = 735
End
Begin VB.ListBox lstlvl
Height = 645
Left = 1800
TabIndex = 25
Top = 5760
Width = 735
End
Begin VB.ListBox lstcolour
Height = 645
Left = 960
TabIndex = 24
Top = 5760
Width = 735
End
Begin VB.ListBox lstspecies
Height = 645
Left = 120
TabIndex = 23
Top = 5760
Width = 735
End
Begin VB.ListBox lstGBA
Height = 840
Left = 120
TabIndex = 22
Top = 2280
Width = 1215
End
Begin VB.TextBox txtproxy
Height = 285
Left = 1200
TabIndex = 21
Text = "host:port"
Top = 5040
Width = 1215
End
Begin VB.CheckBox chkProxy
Caption = "Use Proxy"
Height = 255
Left = 0
TabIndex = 20
Top = 5040
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "Test Proxy"
Height = 255
Left = 2640
TabIndex = 19
Top = 5040
Width = 1095
End
Begin VB.CheckBox chkproglog
Caption = "Save as ProgLog.txt upon closure"
Height = 255
Left = 5040
TabIndex = 18
Top = 5400
Value = 1 'Checked
Width = 2775
End
Begin VB.TextBox txtsave
Height = 285
Left = 6840
TabIndex = 16
Text = "ProgLog"
Top = 4920
Width = 855
End
Begin VB.CommandButton cmdclearitems
Caption = "Clear"
Height = 255
Left = 2040
TabIndex = 13
Top = 4200
Width = 735
End
Begin VB.CommandButton cmdloaditems
Caption = "Load"
Height = 255
Left = 1080
TabIndex = 12
Top = 4200
Width = 855
End
Begin VB.CommandButton cmdSave
Caption = "Save log"
Height = 315
Left = 6600
TabIndex = 11
Top = 4560
Width = 1095
End
Begin MSComDlg.CommonDialog CD
Left = 4200
Top = 5040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdclear
Caption = "Clear"
Height = 255
Left = 1920
TabIndex = 10
Top = 1920
Width = 735
End
Begin VB.CommandButton cmdload
Caption = "Load"
Height = 255
Left = 1080
TabIndex = 9
Top = 1920
Width = 735
End
Begin VB.ListBox lstaccounts
Height = 1425
ItemData = "checker.frx":FE51
Left = 240
List = "checker.frx":FE53
TabIndex = 8
Top = 360
Width = 2415
End
Begin Project1.ctlRipperWrapper RipperWrapper
Left = 4320
Top = 4800
_ExtentX = 847
_ExtentY = 847
GZip = 0 'False
Timeout = 8000
End
Begin VB.ListBox lststatus
Height = 3960
Left = 3000
TabIndex = 7
Top = 360
Width = 4575
End
Begin VB.TextBox txtwait2
Height = 285
Left = 2040
TabIndex = 5
Text = "1000"
Top = 5400
Width = 495
End
Begin VB.TextBox txtwait1
Height = 285
Left = 1080
TabIndex = 4
Text = "500"
Top = 5400
Width = 495
End
Begin VB.CommandButton cmdstop
Caption = "Stop"
Height = 375
Left = 1080
TabIndex = 1
Top = 4560
Width = 975
End
Begin VB.CommandButton cmdStart
Caption = "Start"
Height = 375
Left = 0
TabIndex = 0
Top = 4560
Width = 975
End
Begin VB.Frame Frame2
Caption = "Log"
Height = 4335
Left = 2880
TabIndex = 14
Top = 120
Width = 4815
End
Begin VB.Frame Frame3
Caption = "Accounts"
Height = 1815
Left = 120
TabIndex = 15
Top = 120
Width = 2655
End
Begin VB.Label Label1
Caption = "Save log as"
Height = 255
Left = 5880
TabIndex = 17
Top = 4920
Width = 855
End
Begin VB.Label Label3
Caption = "ms between refreshes"
Height = 255
Left = 2640
TabIndex = 6
Top = 5400
Width = 1575
End
Begin VB.Label Label2
Caption = "Wait between and"
Height = 255
Left = 0
TabIndex = 3
Top = 5400
Width = 1935
End
Begin VB.Label lblstatus
Caption = "Status"
Height = 255
Left = 2280
TabIndex = 2
Top = 4680
Width = 3495
End
End
Attribute VB_Name = "frmchecker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strHTML As String
Dim strprocess As String
Dim StopProgram As Boolean
Dim strMyNeopoints As String
Dim strlocation As String
Dim host As String
Dim port As String
Dim Retry As Boolean
Public Function GBA(ByVal Str As String, start As String, Finish As String, lstAdd As ListBox, Optional Clear As Boolean = True, Optional lgB As Long = 1) As String
On Error Resume Next
If Clear = True Then lstAdd.Clear
Do Until lgB <= lngStop
lgB = InStr(lgB, Str, start)
If lgB + Len(start) >= Len(Str) Or lgB = 0 Then Exit Function
If lgB <> 0 Then lgB = lgB + Len(start): GBA = Mid$(Str, lgB, InStr(lgB, Str, Finish) - lgB): lgB = lgB + 1
lstAdd.AddItem GBA
Loop
End Function
Public Function GetStringBetween(ByVal InputText As String, _
ByVal StartText As String, _
ByVal EndText As String, _
Optional ByVal StartPosition = 1) As String
Dim lnTextStart As Long
Dim lnTextEnd As Long
lnTextStart = InStr(StartPosition, InputText, StartText, vbTextCompare) + Len(StartText)
lnTextEnd = InStr(lnTextStart, InputText, EndText, vbTextCompare)
If lnTextStart >= (StartPosition + Len(StartText)) And lnTextEnd > lnTextStart Then
GetStringBetween = Mid$(InputText, lnTextStart, lnTextEnd - lnTextStart)
Else
GetStringBetween = ""
End If
End Function
Public Function Rand(ByVal Low As Long, _
ByVal High As Long) As Long
Randomize
Rand = Int((High - Low + 1) * Rnd) + Low
End Function
Private Sub cmdclear_Click()
lstaccounts.Clear
End Sub
Private Sub cmdclearitems_Click()
lstitems.Clear
End Sub
Private Sub cmdload_Click()
Dim strFile As String
strFile = SelectFileToLoad(CD)
If Len(strFile) > 1 Then
Call FileModule.TextFileToList(strFile, lstaccounts)
Else
MsgBox ("No file was loaded!")
End If
End Sub
Private Sub cmdloaditems_Click()
Dim strFile As String
strFile = SelectFileToLoad(CD)
If Len(strFile) > 1 Then
Call FileModule.TextFileToList(strFile, lstitems)
Else
MsgBox ("No file was loaded!")
End If
End Sub
Private Sub cmdSave_Click()
Call saveList(lststatus, App.Path & "\" & txtsave.Text & ".txt", "Append")
End Sub
Private Sub cmdStart_Click()
Dim stritem As String
Dim strunique As String
Dim strqty As String
Dim strcheck As String
Dim strTotalNP As String
cmdStart.Enabled = False
cmdstop.Enabled = True
StopProgram = False
If StopProgram = False Then
For X = 0 To lstaccounts.ListCount - 1
strTotalNP = 0
If StopProgram = False Then
lststatus.AddItem ("=====================================")
End If
stringtosplit = lstaccounts.List(X)
temp = Split(stringtosplit, ":")
'temp(0) = user
user = temp(0)
'temp(1) = pass
pass = temp(1)
stringtosplit = txtproxy.Text
temp = Split(stringtosplit, ":")
'temp(0) = user
host = temp(0)
'temp(1) = pass
port = temp(1)
If chkProxy.Value = 1 Then
Call RipperWrapper.SetProxy("" & host, "" & port)
End If
If StopProgram = False Then
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
lblstatus.Caption = "Logging in."
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "POST", "[Only registered and activated users can see links]" & user & "&password=" & pass & "&destination=%2petcentral.phtml/")
If InStr(1, strHTML, "badpassword") Then
lststatus.AddItem ("Account " & user & "had the wrong password.")
lblstatus.Caption = "Invalid Password/Username"
ElseIf InStr(1, strHTML, "This account has been") Then
lststatus.AddItem ("Account " & user & "has been frozen.")
lblstatus.Caption = "Sorry, This Account Has Been Frozen"
ElseIf InStr(1, strHTML, "Update Account") Then
lststatus.AddItem ("Account " & user & " needs to be updated.")
lblstatus.Caption = "Sorry, This Account Has Been Lawyerbotted"
ElseIf InStr(1, strHTML, "It looks like you haven't logged in for a while") Then
lststatus.AddItem ("Account " & user & " needs to be Bday cracked.")
lblstatus.Caption = "Sorry, This Account Hasn't Been Logged in"
ElseIf InStr(1, strHTML, "petcentral") Then
lblstatus.Caption = "Successfully logged in."
End If
If chkProxy.Value = 1 Then
Call RipperWrapper.NoProxy
End If
If StopProgram = False Then
lststatus.AddItem ("Checking account: " & user)
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]" & user)
'vbKeyTab is for tabs
strcheck = GetStringBetween(strHTML, "<b>Secret Avatars:</b><br />", "<br /><br /><br />")
strcheck = Replace(strcheck, vbKeyTab, "")
lststatus.AddItem ("Account has " & strcheck & " avatars.")
strcheck = GetStringBetween(strHTML, "<b>Stamps:</b><br />", "<br /><br />")
strcheck = Replace(strcheck, vbKeyTab, "")
lststatus.AddItem ("Account has " & strcheck & " stamps.")
strcheck = GetStringBetween(strHTML, "<b>Site Themes:</b><br />", "</td>")
strcheck = Replace(strcheck, vbKeyTab, "")
lststatus.AddItem ("Account has " & strcheck & " site themes.")
Call GBA(strHTML, "[Only registered and activated users can see links]", ".gif", lstGBA)
lststatus.AddItem (" Account has " & lstGBA.ListCount & " trophies.")
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
lblstatus.Caption = "Checking Bank."
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strcheck = GetStringBetween(strHTML, "<td align=""center"" style=""font-weight: bold;"">", " NP</td>")
lststatus.AddItem ("Account has " & strcheck & " NP in bank.")
strMyNeopoints = GetStringBetween(strHTML, "objects.phtml?type=inventory"">", "</a>")
lststatus.AddItem ("Account has " & strMyNeopoints & " NP on hand.")
strcheck = Replace(strcheck, ",", "")
strMyNeopoints = Replace(strMyNeopoints, ",", "")
strTotalNP = Val(strTotalNP) + Val(strMyNeopoints) + Val(strcheck)
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strcheck = GetStringBetween(strHTML, "Items:</b> ", " | <b>Qty:</b>")
strqty = GetStringBetween(strHTML, " | <b>Qty:</b>", vbNewLine)
lststatus.AddItem ("Account has " & strcheck & " unique items and " & strqty & " total items in SDB.")
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strcheck = GetStringBetween(strHTML, "<b>Items:</b> ", " | <b>Qty:</b>")
strqty = GetStringBetween(strHTML, " | <b>Qty:</b>", " | <b>Page:</b>")
lststatus.AddItem ("Account has " & strcheck & " unique items and " & strqty & " total items in closet.")
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
lststatus.AddItem ("Now checking pets.")
If InStr(strHTML, "must be converted in order to be fully customisable.") Then
lststatus.AddItem ("Account has unconverted pets!!")
End If
Call GBA(strHTML, "Species:</th><td class='sf'><b>", "</b></td></tr>", lstspecies)
Call GBA(strHTML, "Colour:</th><td class='sf'><b>", "</b></td></tr>", lstcolour)
Call GBA(strHTML, "Level:</th><td class='sf'><b>", "</b></td></tr>", lstlvl)
Call GBA(strHTML, " / ", "</b>", lsthealth)
Call GBA(strHTML, "Strength:</th><td class='sf'><b>", "</b></td></tr>", lststrength)
Call GBA(strHTML, "Defence:</th><td class='sf'><b>", "</b></td></tr>", lstdefence)
Call GBA(strHTML, "Move:</th><td class='sf'><b>", "</b></td></tr>", lstmove)
For i = 0 To lstspecies.ListCount - 1
lststatus.AddItem ("Pet #" & i & " statistics:")
lststatus.AddItem ("Species: " & lstspecies.List(i))
lststatus.AddItem ("Colour: " & lstcolour.List(i))
lststatus.AddItem ("Level: " & lstlvl.List(i))
lststatus.AddItem ("Max Health: " & lsthealth.List(i))
lststatus.AddItem ("Strength: " & lststrength.List(i))
lststatus.AddItem ("Defence: " & lstdefence.List(i))
lststatus.AddItem ("Move: " & lstmove.List(i))
lststatus.AddItem ("------------------------")
Next i
lstspecies.Clear
lstcolour.Clear
lstlvl.Clear
lsthealth.Clear
lststrength.Clear
lstdefence.Clear
lstmove.Clear
MSToWait (Rand(txtwait1.Text, txtwait2.Text))
lststatus.AddItem ("Account has " & strTotalNP & " total NP.")
End If
Else
If StopProgram = False Then
lblstatus.Caption = "Error is Unknown"
lststatus.AddItem ("Account " & user & "has an unknown error.")
End If
End If
Next X
End If
lblstatus.Caption = "Idle..."
End Sub
Private Sub cmdstop_Click()
StopProgram = True
lblstatus.Caption = "Stopped."
cmdStart.Enabled = True
cmdstop.Enabled = False
End Sub
Private Sub Command1_Click()
stringtosplit = txtproxy.Text
temp = Split(stringtosplit, ":")
'temp(0) = user
host = temp(0)
'temp(1) = pass
port = temp(1)
If chkProxy.Value = 1 Then
Call RipperWrapper.SetProxy("" & host, "" & port)
End If
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strHTML = GetStringBetween(strHTML, "Your visible IP address: ", "</h1><h3>")
MsgBox ("Proxy IP is: " & strHTML)
Call RipperWrapper.NoProxy
Call RipperWrapper.Request(strHTML, "GET", "[Only registered and activated users can see links]")
strHTML = GetStringBetween(strHTML, "Your visible IP address: ", "</h1><h3>")
MsgBox ("Regular IP is: " & strHTML & vbNewLine & "(c) [Only registered and activated users can see links]")
End Sub
Private Sub Command2_Click()
Dim nowdate As Date
txtsave.Text = DateValue(Now)
txtsave.Text = Replace(txtsave.Text, "/", "-")
End Sub
Private Sub Form_Load()
txtsave.Text = DateValue(Now)
txtsave.Text = Replace(txtsave.Text, "/", "-")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call saveList(lststatus, App.Path & "\ProgLog.txt", "Append")
Dim frm As Form
For Each frm In Forms
Unload frm
Next
End Sub
Private Sub txtproxy_Click()
txtproxy.Text = ""
End Sub
Here's some good links that might not be in the source:
Bank [Only registered and activated users can see links] **
Safety Deposit Box [Only registered and activated users can see links]
Closet [Only registered and activated users can see links]
Petpets [Only registered and activated users can see links]
Battledome [Only registered and activated users can see links]
Neocash Items [Only registered and activated users can see links]
Inventory [Only registered and activated users can see links]
Shop [Only registered and activated users can see links]
Shop Till [Only registered and activated users can see links]
Gallery [Only registered and activated users can see links]
Neodeck [Only registered and activated users can see links]
Stock Market [Only registered and activated users can see links]
Storage Shed [Only registered and activated users can see links]
Neohome Items [Only registered and activated users can see links]
Neggery [Only registered and activated users can see links]
Laboratory [Only registered and activated users can see links]
Keyquest [Only registered and activated users can see links]
Rainbow Fountain (FFQ) [Only registered and activated users can see links]
World Challenge [Only registered and activated users can see links]
TCG Album [Only registered and activated users can see links]
Unused Plot Points (Return of Sloth) [Only registered and activated users can see links]
Unused Plot Points (Tale of Woe) [Only registered and activated users can see links]
Unused Plot Points (Lost Desert) [Only registered and activated users can see links]
Unused Plot Points (Altador Cup) [Only registered and activated users can see links]
Unused Plot Points (The Faeries' Ruin)[Only registered and activated users can see links]