[vb6] Guess the card auto player source

Discussion in 'Code Snippets and Tutorials' started by Violent_J, Dec 4, 2008.

  1. Violent_J

    Violent_J Level I

    Joined:
    Oct 21, 2008
    Messages:
    41
    Likes Received:
    1
    Just an old source. When I was a beginner, I made a shitty one. This is improved lol



    Code (Text):
    1. Private Declare Function GetTickCount Lib "kernel32" () As Long
    2.  
    3. Dim Dpage As String, strHTML As String, X As Integer, strGuess As String, HTML As String, StopProgram As Boolean, lngsearches As Long
    4.  
    5. Public Function GB(rC As String, rS As String, rF As String, Optional lgB As Long = 1) As String
    6.     lgB = InStr(lgB, rC, rS) + Len(rS): GB = Mid$(rC, lgB, InStr(lgB, rC, rF) - lgB)
    7. End Function
    8.  
    9.  
    10. Public Sub Pause(Milliseconds As Single)
    11.     Dim t As Single, t2 As Single, Num As Single
    12.     Num = Milliseconds: t = GetTickCount(): t2 = GetTickCount()
    13.     Do Until t2 - t >= Num
    14.         t2 = GetTickCount(): DoEvents:
    15.     Loop
    16. End Sub
    17.  
    18. Public Function rand(ByVal Min As Double, _
    19.                      ByVal Max As Double) As Double    ' A good random function '
    20.     Dim r As Double
    21.     Randomize
    22.     rand = Int(Rnd * (Max - Min + 1)) + Min
    23. End Function
    24.  
    25. Private Sub Form_Load()
    26.     chksave.Value = GetSetting("Violent_J's guess the card", "Login", "Save Login Information", Checked)
    27.     If chksave.Value = Checked Then
    28.         txtuser.Text = GetSetting("Violent_J's guess the card", "Login", "Username")
    29.         txtpass.Text = GetSetting("Violent_J's guess the card", "Login", "Password")
    30.     End If
    31. End Sub
    32.  
    33. Private Sub cmdmin_Click()
    34.     tray.Show
    35.     frmmain.Visible = False
    36. End Sub
    37.  
    38.  
    39.  
    40.  
    41.  
    42.  
    43. Private Sub tray_DoubleClick()
    44.     tray.Hide
    45.     frmmain.Visible = True
    46. End Sub
    47.  
    48. Private Sub cmdsave_Click()
    49.     On Error Resume Next
    50.     Me.CD.Filter = "Text Files (*.txt)| *.txt"
    51.     CD.ShowSave
    52.     Open CD.FileName For Output As #1
    53.     Print #1, txtlog.Text
    54.     Close #1
    55.  
    56.  
    57. End Sub
    58.  
    59.  
    60.  
    61.  
    62. Private Sub cmdupdate_Click()
    63.     HTML = frmmain.w.GetWrapper("http://www.neopets.com/index.phtml/")
    64.  
    65.     If InStrB(1, HTML, ">&raquo</span> Customise</b></a></td>") Then
    66.  
    67.         frmmain.lbluser.Caption = GB(HTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
    68.         frmmain.lblpet.Caption = GB(HTML, "<a href=" & ChrW$(34) & "/quickref.phtml" & ChrW$(34) & "><b>", "</b></a>")
    69.         frmmain.lblNP.Caption = GB(HTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")
    70.         cmdstart.Enabled = True
    71.     Else
    72.         frmmain.lbluser.Caption = GB(HTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
    73.         frmmain.lblpet.Caption = "None"
    74.         frmmain.lblNP.Caption = GB(HTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")
    75.     End If
    76. End Sub
    77.  
    78.  
    79.  
    80. Private Sub cmdclear_Click()
    81.     txtlog = Empty
    82. End Sub
    83.  
    84. Private Sub cmdreset_Click()
    85.     lblwins.Caption = "0"
    86.     lblloss.Caption = "0"
    87.     lblplays.Caption = "0"
    88. End Sub
    89.  
    90.  
    91.  
    92. Private Sub cmdLogin_click()
    93.  
    94.     cmdlogin.Enabled = False
    95.     lblstatus.Caption = "Logging in..."
    96.     strHTML = w.PostWrapper("http://www.neopets.com/login.phtml", "username=" & txtuser.Text & "&password=" & txtpass.Text & "&destination=%2Findex.phtml", "http://www.neopets.com/hi.phtml")
    97.     If InStr(1, strHTML, "badpassword") Then
    98.         lblstatus.Caption = "Bad Password"
    99.         cmdlogin.Enabled = True
    100.     ElseIf InStr(1, strHTML, "This account has been") Then
    101.         lblstatus.Caption = "Account Frozen"
    102.         cmdlogin.Enabled = True
    103.     ElseIf InStr(1, strHTML, txtUsername) Then
    104.         Call SaveSetting("Violent_J's guess the card", "Login", "Username", txtuser.Text)
    105.         Call SaveSetting("Violent_J's guess the card", "Login", "Password", txtpass.Text)
    106.         Call SaveSetting("Violent_J's guess the card", "Login", "Save Login Information", chksave.Value)
    107.         lblstatus.Caption = "Logged in..."
    108.         txtlog.Text = Time & " : Logged in as " & txtuser.Text & ""
    109.         cmdstart.Enabled = True
    110.         cmdupdate.Enabled = True
    111.         strHTML = frmmain.w.GetWrapper("http://www.neopets.com/index.phtml/")
    112.  
    113.         If InStrB(1, strHTML, ">&raquo</span> Customise</b></a></td>") Then
    114.  
    115.             frmmain.lbluser.Caption = GB(strHTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
    116.             frmmain.lblpet.Caption = GB(strHTML, "<a href=" & ChrW$(34) & "/quickref.phtml" & ChrW$(34) & "><b>", "</b></a>")
    117.             frmmain.lblNP.Caption = GB(strHTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")
    118.  
    119.         Else
    120.             frmmain.lbluser.Caption = GB(strHTML, "/userlookup.phtml?user=", "" & ChrW$(34) & ">")
    121.             frmmain.lblpet.Caption = "None"
    122.             frmmain.lblNP.Caption = GB(strHTML, "/objects.phtml?type=inventory" & ChrW$(34) & ">", "</a>")
    123.  
    124.             txtlog.Text = txtlog.Text & vbNewLine & Time & " : You need a pet to play this game!"
    125.             cmdstart.Enabled = False
    126.  
    127.  
    128.         End If
    129.  
    130.     End If
    131. End Sub
    132.  
    133.  
    134.  
    135.  
    136. Private Sub cmdStart_Click()
    137.  
    138.     cmdstart.Enabled = False
    139.     cmdstop.Enabled = True
    140.     txtlog.Text = txtlog.Text & vbNewLine & Time & " : Started Playing!"
    141.     Do Until cmdstop.Enabled = False
    142.  
    143.         lblguess.Caption = rand(1, 6)
    144.  
    145.  
    146.  
    147.         If chkstop.Value = Checked And X >= txtstop.Text Then
    148.             txtlog = txtlog & vbNewLine & Time & " : Program has reached the criteria you specified to stop at!"
    149.             cmdStop_click
    150.         End If
    151.         If chkshut.Value = Checked And X >= txtshut Then
    152.             Unload Me
    153.         End If
    154.         If lngsearches >= Val(txtplay.Text) And chktime.Value = Checked Then
    155.             txtlog.Text = txtlog.Text & vbNewLine & Time & " : " & Val(txtplay.Text) & " game(s) played, waiting " & Val(txtmin.Text) & " minutes!"
    156.             Pause (Val(txtmin.Text) * 60000)
    157.             txtlog.Text = txtlog.Text & vbNewLine & Time & " : Paused for " & Val(txtmin.Text) & " Minutes..."
    158.             lngsearches = 0
    159.         End If
    160.         strHTML = w.GetWrapper("http://www.neopets.com/games/process_psy.phtml?cards=" & lblguess.Caption, "http://www.neopets.com/games/psychoanalysis.phtml")
    161.         lblplays.Caption = lblplays.Caption + 1
    162.         X = X + 1
    163.         lngsearches = lngsearches + 1
    164.         If InStrB(1, strHTML, "Congratulations your pet is psychic!") Then
    165.             txtlog = txtlog & vbNewLine & Time & " - You won 50 neopoints!"
    166.             lblwins.Caption = lblwins.Caption + 1
    167.             If chkprofit.Value = Checked Then lblwinnings.Caption = lblwinnings.Caption + 50: lbltotal.Caption = Val(lblwinnings.Caption) + Val(lbllosings.Caption)
    168.         ElseIf InStrB(1, strHTML, "Wrong!") Then
    169.             txtlog = txtlog & vbNewLine & Time & " : You lost 10 neopoints!"
    170.             lblloss.Caption = lblloss.Caption + 1
    171.             If chkprofit.Value = Checked Then lbllosings.Caption = lbllosings.Caption - 10: lbltotal.Caption = Val(lblwinnings.Caption) + Val(lbllosings.Caption)
    172.         Else
    173.             txtlog = txtlog & vbNewLine & Time & " : Unknown event at "
    174.         End If
    175.         txtlog = txtlog & vbNewLine & Time & " : " & Val(Int(Math.Rnd() * ((Val(txty + 1)) - Val(txtx)) + Val(txtx))) & " Seconds before playing another game!"
    176.         SleepModule.SecondsToWait Int(Math.Rnd() * ((Val(txty + 1)) - Val(txtx)) + Val(txtx))
    177.     Loop
    178.     txtlog = txtlog & vbNewLine & Time & " - Finished Playing!"
    179.     cmdstart.Enabled = True
    180.     cmdstop.Enabled = False
    181. End Sub
    182.  
    183. Private Sub cmdStop_click()
    184.     cmdstart.Enabled = True
    185.     cmdstop.Enabled = False
    186.     txtlog = txtlog & vbNewLine & Time & " : Stopped Program"
    187. End Sub
    188.  
    189. Sub UnloadMe()
    190.     Dim frmTemp As Form
    191.     For Each frmTemp In Forms
    192.         Unload frmTemp
    193.         Set frmTemp = Nothing
    194.     Next
    195. End Sub
    196.  
    197.  
    198.  
    199. Private Sub Form_Unload(Cancel As Integer)
    200.  
    201.     Dim frmTemp As Form
    202.     For Each frmTemp In Forms
    203.         Unload frmTemp
    204.         Set frmTemp = Nothing
    205.     Next
    206.     End
    207. End Sub
    G.u.i​

    [​IMG]
     
    #1 Violent_J, Dec 4, 2008
    Cacklenub likes this.