Daily Doer Source

[PhearAlmighty]

Dim strhtml As String
Dim strTest As String



Private Sub cmdClear_Click()
lstLog.Clear
End Sub

Private Sub cmdLogin_Click()
If txtUser.Text = "" Then MsgBox "Enter Username!": Exit Sub
    If txtPass.Text = "" Then MsgBox "Enter Password!": Exit Sub
    cmdLogin.Enabled = False
    txtUser.Locked = True
    txtPass.Locked = True
        'login process:
        lblStatus.Caption = "Logging in (1/3)"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/hi.phtml", "destination=%2Fpetcentral.phtml&username=" & txtUser.Text, "http://www.neopets.com/loginpage.phtml")
        lblStatus.Caption = "Posting User (2/3)"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/login.phtml", "username=" & txtUser.Text & "&password=" & txtPass.Text & "&destination=%2Fpetcentral.phtml", "http://www.neopets.com/hi.phtml")
        lblStatus.Caption = "Posting User & Pass (3/3)"
            If InStr(strhtml, "badpassword.phtml") Then
                lblStatus.Caption = "Bad Password"
                cmdLogin.Enabled = True
            ElseIf InStr(strhtml, "petcentral.phtml") Then
                cmdLogout.Enabled = True
                lblStatus.Caption = "Login Was Successful"
                FrameSettings.Enabled = True
                FrameControls.Enabled = True
                FrameLog.Enabled = True
                cmdStart.Enabled = True
                Me.Caption = Me.Caption & " : " & txtUser.Text
                Exit Sub
            ElseIf InStr(strhtml, "FROZEN") Then
                lblStatus.Caption = "That account was frozen, Sorry"
                cmdLogin.Enabled = True
End If
txtUser.Locked = False
    txtPass.Locked = False
End Sub

Private Sub cmdLogout_Click()
chkAdvent.Value = Unchecked
chkFishing.Value = Unchecked
chkFruit.Value = Unchecked
chkTomb.Value = Unchecked
chkHealing.Value = Unchecked
chkJelly.Value = Unchecked
chkMeteor.Value = Unchecked
chkOmelette.Value = Unchecked
chkShrine.Value = Unchecked
chkTombola.Value = Unchecked
chkWOE.Value = Unchecked
chkWOM.Value = Unchecked
lblStatus.Caption = "Logged Out"
    Me.Caption = "Phony Productions - Daily Doer [3vo]"
    lblStatus.Caption = "Logged Out"
    cmdLogout.Enabled = False
    lblStatus.Caption = "Logged Out"
    cmdLogin.Enabled = True
    lblStatus.Caption = "Logged Out"
wrapper.GetWrapper "http://www.neopets.com/logout.phtml"
    lblStatus.Caption = "Logged Out"
        wrapper.ClearCookies
            lblStatus.Caption = "Logged Out"
                    FrameSettings.Enabled = False
                    FrameLog.Enabled = False
                    FrameControls.Enabled = False
End Sub

Private Sub cmdSave_Click()
    Call Functions.SaveList(App.Path & "\log.txt", lstLog, "Output")
End Sub

Private Sub cmdStart_Click()
    cmdStart.Enabled = False
    lblStatus.Caption = "Doing Dailies"
            Call DoDailies
    cmdStart.Enabled = True
    lblStatus.Caption = "Finished"
End Sub

Private Sub DoDailies()
lstLog.AddItem "Started Dailies - " & Time

    If chkAdvent.Value = Checked Then
        If Month(Now) = 12 Then
    lblStatus.Caption = "Advent Calendar"
    strhtml = wrapper.PostWrapper("http://www.neopets.com/winter/process_adventcalendar.phtml", "", wrapper.LastPage)
    lstLog.AddItem "Advent Calendar:"
    lstLog.AddItem "Done."
    End If
    End If
    
    If chkFishing.Value = Checked Then
    lblStatus.Caption = "Underwater Fishing"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/water/fishing.phtml", "go_fish=1", wrapper.LastPage)
        lstLog.AddItem "Underwater Fishing:"
            If InStr(strhtml, "Your pet's fishing skill increases to <B>") Then
            lstLog.AddItem "Fishing Level: " & GB(strhtml, ">Your pet's fishing skill increases to <B>", "</B>!<P></CENT")
            Else
            lstLog.AddItem "Did Not Gain Fishing Level."
            End If
    End If
     
     
    If chkFruit.Value = Checked Then
        lblStatus.Caption = "Fruit Machine"
        strhtml = wrapper.GetWrapper("http://www.neopets.com/desert/fruitmachine2.phtml", wrapper.LastPage)
        lstLog.AddItem "Fruit Machine:"
        lstLog.AddItem "Spun."
    End If
        
    If chkHealing.Value = Checked Then
        lblStatus.Caption = "Healing Springs"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/faerieland/springs.phtml", "type=heal", wrapper.LastPage)
        lstLog.AddItem "Healing Springs:"
        lstLog.AddItem "Done."
    End If

    If chkJelly.Value = Checked Then
    lblStatus.Caption = "Jelly"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/jelly/jelly.phtml", "type=get_jelly", wrapper.LastPage)
        lstLog.AddItem "Jelly:"
        strTest = GB(strhtml, "=80 height=80 border=0><p>You take some <b>", "</b>!!!")
            If strTest = vbNullString Then strTest = "Did Not Get Jelly."
            If strTest = "" Then strTest = "Did Not Get Jelly."
            lstLog.AddItem strTest
    End If

    If chkMeteor.Value = Checked Then
        lblStatus.Caption = "Meteors of Kreludor"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/moon/process_meteor.phtml", "pickstep=" & Functions.Rand(1, 2) & "&meteorsubmit=Submit", wrapper.LastPage)
        lstLog.AddItem "Meteors of Kreludor:"
        lstLog.AddItem "Done."
    End If
    
    If chkOmelette.Value = Checked Then
    lblStatus.Caption = "Omelette"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/prehistoric/omelette.phtml", "type=get_omelette", wrapper.LastPage)
            lstLog.AddItem "Omelette:"
                If InStr(strhtml, "<img src='http://images.neopets.com/items") Then lstLog.AddItem "Got Omelette."
    End If
    
    If chkShrine.Value = Checked Then
        lblStatus.Caption = "Shrine"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/desert/shrine.phtml", "type=approach", wrapper.LastPage)
        lstLog.AddItem "Shrine:"
        strTest = GB(strhtml, "</b><p><b>", "</b><p><IMG src=")
        If strTest = vbNullString Then strTest = "Shrine Done."
        If strTest = "" Then strTest = "Shrine Done."
        lstLog.AddItem strTest
    End If

    If chkTomb.Value = Checked Then
        lblStatus.Caption = "Geraptiku Tomb"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/worlds/geraptiku/process_tomb.phtml", "", wrapper.LastPage)
        lstLog.AddItem "Geraptiku Tomb:"
        lstLog.AddItem "Done."
    End If
    
    If chkTombola.Value = Checked Then
        lblStatus.Caption = "Tombola"
        strhtml = wrapper.GetWrapper("http://www.neopets.com/island/tombola2.phtml", wrapper.LastPage)
        lstLog.AddItem "Tombola:"
        lstLog.AddItem "Done."
    End If
    
    If chkWOE.Value = Checked Then
        lblStatus.Caption = "Wheel of Excitement"
        strhtml = wrapper.GetWrapper("http://www.neopets.com/faerieland/wheel2.phtml?", wrapper.LastPage)
        lstLog.AddItem "Wheel of Excitement:"
        lstLog.AddItem "Done."
    End If
    
    If chkWOM.Value = Checked Then
        lblStatus.Caption = "Wheel of Mediocrity"
        strhtml = wrapper.PostWrapper("http://www.neopets.com/prehistoric/mediocrity2.phtml", "", wrapper.LastPage)
        lstLog.AddItem "Wheel of Mediocrity:"
        lstLog.AddItem "Done."
    End If
    
        lstLog.AddItem "Finished Dailies - " & Time
        
End Sub
Private Sub Form_Unload(Cancel As Integer)
strhtml = wrapper.GetWrapper("http://www.neopets.com/logout.phtml", wrapper.LastPage)
wrapper.ClearCookies
wrapper.StopIT = True
Call EndIt
End Sub

[cody4camp]

ripped from www.slopdog.com from raredaredevil ASSHOLE

[Simultaneous]

Look at how old the post is, ASSHOLE.

[Wilfukguys]

Thanks for the source, though you really shouldnt rip it >>
Im trying to understand how it works right now, to see if i can make a daily-doer.
Having a bit of trouble ;-;
Though i am new to vb6

[raredaredevil]

Is this really my code? i dont remember making it , Anna posted one on slopdogg that she made, from my account but that was on a timer, not just run once and exit so i dont think its mine or Annas.

Maybe they took some of annas source but she wouldnt care anyway.

[Wilfukguys]

well help me get this thing to work then xD

[eckkotc203]

add me on MSN ill help you.

and rare. add me also. i need to ask you something.

my msn is eckotc203@live . com

[Wilfukguys]

get on msn =P
im on =P