[vb6] Updated Guess The card Autoplayer source

**Violent_J** · 08-21-2008, 06:49 PM

Code:

Private Declare Function GetTickCount Lib "kernel32" () As Long

Dim Dpage As String, strHTML As String, X As Integer, strGuess As String, HTML As String, StopProgram As Boolean, lngsearches As Long

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


Public Sub Pause(Milliseconds As Single)
    Dim t As Single, t2 As Single, Num As Single
    Num = Milliseconds: t = GetTickCount(): t2 = GetTickCount()
    Do Until t2 - t >= Num
        t2 = GetTickCount(): DoEvents:
    Loop
End Sub

Public Function rand(ByVal Min As Double, _
                     ByVal Max As Double) As Double    ' A good random function '
    Dim r As Double
    Randomize
    rand = Int(Rnd * (Max - Min + 1)) + Min
End Function

Private Sub Form_Load()
    chksave.Value = GetSetting("Violent_J's guess the card", "Login", "Save Login Information", Checked)
    If chksave.Value = Checked Then
        txtuser.Text = GetSetting("Violent_J's guess the card", "Login", "Username")
        txtpass.Text = GetSetting("Violent_J's guess the card", "Login", "Password")
    End If
End Sub

Private Sub cmdmin_Click()
    tray.Show
    frmmain.Visible = False
End Sub






Private Sub tray_DoubleClick()
    tray.Hide
    frmmain.Visible = True
End Sub

Private Sub cmdsave_Click()
    On Error Resume Next
    Me.CD.Filter = "Text Files (*.txt)| *.txt"
    CD.ShowSave
    Open CD.FileName For Output As #1
    Print #1, txtlog.Text
    Close #1


End Sub




Private Sub cmdupdate_Click()
    HTML = frmmain.w.GetWrapper("http://www.neopets.com/index.phtml/")

    If InStrB(1, HTML, ">&raquo</span> Customise</b></a></td>") Then

        frmmain.lbluser.Caption = GB(HTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
        frmmain.lblpet.Caption = GB(HTML, "<a href=" & ChrW$(34) & "/quickref.phtml" & ChrW$(34) & "><b>", "</b></a>")
        frmmain.lblNP.Caption = GB(HTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")
        cmdstart.Enabled = True
    Else
        frmmain.lbluser.Caption = GB(HTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
        frmmain.lblpet.Caption = "None"
        frmmain.lblNP.Caption = GB(HTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")
    End If
End Sub



Private Sub cmdclear_Click()
    txtlog = Empty
End Sub

Private Sub cmdreset_Click()
    lblwins.Caption = "0"
    lblloss.Caption = "0"
    lblplays.Caption = "0"
End Sub



Private Sub cmdLogin_click()

    cmdlogin.Enabled = False
    lblstatus.Caption = "Logging in..."
    strHTML = w.PostWrapper("http://www.neopets.com/login.phtml", "username=" & txtuser.Text & "&password=" & txtpass.Text & "&destination=%2Findex.phtml", "http://www.neopets.com/hi.phtml")
    If InStr(1, strHTML, "badpassword") Then
        lblstatus.Caption = "Bad Password"
        cmdlogin.Enabled = True
    ElseIf InStr(1, strHTML, "This account has been") Then
        lblstatus.Caption = "Account Frozen"
        cmdlogin.Enabled = True
    ElseIf InStr(1, strHTML, txtUsername) Then
        Call SaveSetting("Violent_J's guess the card", "Login", "Username", txtuser.Text)
        Call SaveSetting("Violent_J's guess the card", "Login", "Password", txtpass.Text)
        Call SaveSetting("Violent_J's guess the card", "Login", "Save Login Information", chksave.Value)
        lblstatus.Caption = "Logged in..."
        txtlog.Text = Time & " : Logged in as " & txtuser.Text & ""
        cmdstart.Enabled = True
        cmdupdate.Enabled = True
        strHTML = frmmain.w.GetWrapper("http://www.neopets.com/index.phtml/")

        If InStrB(1, strHTML, ">&raquo</span> Customise</b></a></td>") Then

            frmmain.lbluser.Caption = GB(strHTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
            frmmain.lblpet.Caption = GB(strHTML, "<a href=" & ChrW$(34) & "/quickref.phtml" & ChrW$(34) & "><b>", "</b></a>")
            frmmain.lblNP.Caption = GB(strHTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")

        Else
            frmmain.lbluser.Caption = GB(strHTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
            frmmain.lblpet.Caption = "None"
            frmmain.lblNP.Caption = GB(strHTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")

            txtlog.Text = txtlog.Text & vbNewLine & Time & " : You need a pet to play this game!"
            cmdstart.Enabled = False


        End If

    End If
End Sub




Private Sub cmdStart_Click()

    cmdstart.Enabled = False
    cmdstop.Enabled = True
    txtlog.Text = txtlog.Text & vbNewLine & Time & " : Started Playing!"
    Do Until cmdstop.Enabled = False

        lblguess.Caption = rand(1, 6)



        If chkstop.Value = Checked And X >= txtstop.Text Then
            txtlog = txtlog & vbNewLine & Time & " : Program has reached the criteria you specified to stop at!"
            cmdStop_click
        End If
        If chkshut.Value = Checked And X >= txtshut Then
            Unload Me
        End If
        If lngsearches >= Val(txtplay.Text) And chktime.Value = Checked Then
            txtlog.Text = txtlog.Text & vbNewLine & Time & " : " & Val(txtplay.Text) & " game(s) played, waiting " & Val(txtmin.Text) & " minutes!"
            Pause (Val(txtmin.Text) * 60000)
            txtlog.Text = txtlog.Text & vbNewLine & Time & " : Paused for " & Val(txtmin.Text) & " Minutes..."
            lngsearches = 0
        End If
        strHTML = w.GetWrapper("http://www.neopets.com/games/process_psy.phtml?cards=" & lblguess.Caption, "http://www.neopets.com/games/psychoanalysis.phtml")
        lblplays.Caption = lblplays.Caption + 1
        X = X + 1
        lngsearches = lngsearches + 1
        If InStrB(1, strHTML, "Congratulations your pet is psychic!") Then
            txtlog = txtlog & vbNewLine & Time & " - You won 50 neopoints!"
            lblwins.Caption = lblwins.Caption + 1
            If chkprofit.Value = Checked Then lblwinnings.Caption = lblwinnings.Caption + 50: lbltotal.Caption = Val(lblwinnings.Caption) + Val(lbllosings.Caption)
        ElseIf InStrB(1, strHTML, "Wrong!") Then
            txtlog = txtlog & vbNewLine & Time & " : You lost 10 neopoints!"
            lblloss.Caption = lblloss.Caption + 1
            If chkprofit.Value = Checked Then lbllosings.Caption = lbllosings.Caption - 10: lbltotal.Caption = Val(lblwinnings.Caption) + Val(lbllosings.Caption)
        Else
            txtlog = txtlog & vbNewLine & Time & " : Unknown event at "
        End If
        txtlog = txtlog & vbNewLine & Time & " : " & Val(Int(Math.Rnd() * ((Val(txty + 1)) - Val(txtx)) + Val(txtx))) & " Seconds before playing another game!"
        SleepModule.SecondsToWait Int(Math.Rnd() * ((Val(txty + 1)) - Val(txtx)) + Val(txtx))
    Loop
    txtlog = txtlog & vbNewLine & Time & " - Finished Playing!"
    cmdstart.Enabled = True
    cmdstop.Enabled = False
End Sub

Private Sub cmdStop_click()
    cmdstart.Enabled = True
    cmdstop.Enabled = False
    txtlog = txtlog & vbNewLine & Time & " : Stopped Program"
End Sub

Sub UnloadMe()
    Dim frmTemp As Form
    For Each frmTemp In Forms
        Unload frmTemp
        Set frmTemp = Nothing
    Next
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