Trainer Source Code

Written in VB6. Uses a winsock client in a user control to connect etc. Not included. Not commented either.

Option Explicit

Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Const strGameURL = "http://neopets.com/games/meercachase.phtml"
Const lngGameID = 46

Dim bolLoggedIn As Boolean
Dim strHTML As String
Dim strLoadURL As String

Dim intTimes As Long
Dim lngBonus As Long
Dim lng100thScore As Long
Dim strLoadMain As String

Private Sub cmdDoubleScore_Click()
    lngBonus = shkFlash.GetVariable("_level10.BONUS")
    intTimes = intTimes * 2
    lblDoubleScore.Caption = "x" & intTimes
    lngBonus = lngBonus * 2
    Call shkFlash.SetVariable("_level10.BONUS", lngBonus)
End Sub

Private Sub Form_Initiate()
    InitCommonControls
End Sub

Private Sub cmdNoTail_Click()
    If (cmdNoTail.Caption = "Start No Tail Hack") Then
        tmrNoTail.Enabled = True
        cmdNoTail.Caption = "Stop No Tail Hack"
        lblNoTail.Caption = "Enabled"
    ElseIf (cmdNoTail.Caption = "Stop No Tail Hack") Then
        tmrNoTail.Enabled = False
        cmdNoTail.Caption = "Start No Tail Hack"
        lblNoTail.Caption = "Disabled"
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub Form_Load()
    intTimes = 1
End Sub
Private Sub cmdLoad_Click()
Dim strTemp As String
    'Get the 200th score
    lblStatus.Caption = "Getting 100th Score"
    strHTML = HTTPWrapper.Request("GET", "http://neopets.com/gamescores.phtml?game_id=" & lngGameID & "&limit=100", "http://neopets.com/gamescores.phtml?game_id=" & lngGameID)
    strHTML = Between(strHTML, "<td align=center rowspan=1></td></tr><tr><td align=center>100</td>", "<td align=center rowspan=1></td>")
    strHTML = Replace(strHTML, "<td align=center><a href='randomfriend.phtml?user=", vbNullString)
    lng100thScore = Between(strHTML, "<td align=center>", "</td>")
    lblTopScore = lng100thScore
    
    'Navigate to the page
    lblStatus.Caption = "Navigating to game page"
    strHTML = HTTPWrapper.Request("GET", strGameURL, "http://neopets.com/gameroom.phtml")
    
    'Get the game URL
    strLoadURL = Between(strHTML, "game_win = window.open('", ", 'newwin_")
    strLoadURL = Replace(strLoadURL, "'+quality", "high")
    
    Dim strHeight As String
    Dim strWidth As String
    Dim strGameSize As String
    
    strHeight = Between(strLoadURL, "height=", "&width=")
    strWidth = Between(strLoadURL, "&width=", "'+sizestr2+'")
    strGameSize = "&gamewidth=" & strWidth & "&gameheight=" & strHeight
    
    strLoadURL = Replace(strLoadURL, "'+sizestr2+'", strGameSize)
    
    'Load the game
    lblStatus.Caption = "Loading Game"
    strHTML = HTTPWrapper.Request("GET", strLoadURL)
    
    strLoadMain = Between(strHTML, "<PARAM name=""movie"" value=""", """><PARAM name=""quality"" value=""high"">")
    shkFlash.Movie = strLoadMain
    
    cmdLoad.Enabled = False
    cmdNoTail.Enabled = True
    cmdDoubleScore.Enabled = True
    lblLoaded.Caption = "True"
    
End Sub

Private Sub cmdLogin_Click()

    'Make sure username and password are correct
    If (txtUsername.Text = vbNullString) Then
        MsgBox "You must enter a username", vbCritical
        Exit Sub
    ElseIf (txtPassword.Text = vbNullString) Then
        MsgBox "You must enter a password", vbCritical
    End If
    
    lblStatus.Caption = "Logging In"
    strHTML = HTTPWrapper.Request("POST", "http://neopets.com/login.phtml?username=" & txtUsername & "&password=" & txtPassword & "&destination=/petcentral.phtml", "http://www.neopets.com")
            
    If InStr(1, strHTML, "Location: /petcentral.phtml") Then
        MsgBox "Logged in as " & txtUsername, vbInformation
        bolLoggedIn = True
        lblStatus.Caption = "Logged In"
        cmdLoad.Enabled = True
        cmdLogin.Enabled = False
    ElseIf InStr(1, strHTML, "/badpassword.phtml?") Then
        MsgBox "Error Logging In", vbCritical
        bolLoggedIn = False
        lblStatus.Caption = "Error Logging In"
    Else
        MsgBox "Error Logging In", vbCritical
        bolLoggedIn = False
        lblStatus.Caption = "Error Logging In"
    End If
End Sub

Private Sub lblScore_Change()
    intTimes = 1
    lblDoubleScore.Caption = "x1"
End Sub

Private Sub tmrNoTail_Timer()
    'No Tail
    Call shkFlash.SetVariable("_level10.hero.tailnum", "0")
End Sub

Private Sub tmrScore_Timer()
On Error Resume Next
Dim lngScore As Long

    lblScore.Caption = shkFlash.GetVariable("_level10.displayscore")
    lngScore = lblScore.Caption
    If (lngScore > lng100thScore) Then
        If (lblScore.Caption - lblTopScore.Caption >= 500) Then
            MsgBox "You are way over the limit. Program Aborted.", vbCritical
            shkFlash.Movie = strLoadMain
            tmrNoTail.Enabled = False
            cmdNoTail.Enabled = False
            cmdDoubleScore.Enabled = False
            cmdLoad.Enabled = True
            tmrScore.Enabled = False
            Exit Sub
        End If
        tmrNoTail.Enabled = False
        cmdNoTail.Enabled = False
        cmdDoubleScore.Enabled = False
        MsgBox "You have reached the score limit - Program Stopped", vbCritical
        tmrScore.Enabled = False
        shkFlash.Movie = strLoadMain
        Exit Sub
    End If
    
End Sub

[Shane]

Nice job, I was actually just browsing google for this.xD

Glad someone found it to be of some use

[070186333]

where u put the code? wat progremm?

This is a Visual Basic 6.0 Source Code

[M52]

Nice Job Dude

[Cadexn]

what the heck is this... O.O

omg how you do that

[Snakebite]

hmm this confused the shit out of me but i gotta learn stuff sooner or later either a job in computers or in brewmasteryism

Wow, cool,i was also searching google for this....thx