[VB6] Ultimate auto refresher

Sub · 09-18-2006, 09:10 AM

Another old source, but maybe you could learn something from it.

Code:

Public Function rand(ByVal Min As Double, _
        ByVal Max As Double) As Double   ' A good random function '
    Dim r As Double
    If Not bolAfterFirstCall Then
        Randomize
        bolAfterFirstCall = True
    End If
    rand = Int(Rnd * (Max - Min + 1)) + Min
End Function
 
 
Private Sub Command10_Click()
Timer1.Enabled = True
Label1.Caption = "Refreshing.."
End Sub
Private Sub Command11_Click()
Timer1.Enabled = False
End Sub
Private Sub Command12_Click()
Timer2.Enabled = True
End Sub
Private Sub Command13_Click()
Timer2.Enabled = False
End Sub
Private Sub Command14_Click()
Timer3.Enabled = True
End Sub
Private Sub Command15_Click()
Timer3.Enabled = False
End Sub
Private Sub Command2_Click()
List1.Clear
End Sub
Private Sub Command4_Click()
List2.Clear
End Sub
 
Private Sub Command6_Click()
List3.Clear
End Sub
Private Sub Command7_Click()
List1.AddItem Text1.Text
Text1.Text = ""
End Sub
Private Sub Command8_Click()
List2.AddItem Text2.Text
Text2.Text = ""
End Sub
Private Sub Command9_Click()
List3.AddItem Text3.Text
Text3.Text = ""
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub
Private Sub Form_Load()
    txtUser = GetSetting(App.EXEName, "Login", "Username")
    txtPass = GetSetting(App.EXEName, "Login", "Password")
End Sub
Private Sub cmdLogin_Click()
Label13.Caption = ""
     If ((txtUser = Empty Or txtPass = Empty)) Then
        Label1.Caption = "Please enter a user/pass combination."
    Else
 
        Select Case Combo1.Text
            Case "Netscape 8"
                Agent = "Mozilla/5.0 (Windows; U; Windows NT 5.0; en-US; rv:1.7.5) Gecko/20050519 Netscape/8.0.1"
            Case "Netscape 7.2"
                Agent = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.2) Gecko/20040804 Netscape/7.2 (ax)"
            Case "Netscape 6.1"
                Agent = "Mozilla/5.0 (Windows; U; Win98; en-US; rv:0.9.2) Gecko/20010726 Netscape6/6.1"
            Case "AOL browser"
                Agent = "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-US; rv:1.0.2) Gecko/20020924 AOL/7.0"
            Case "IE 6#"
                Agent = "MMozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
            Case "Konqueror 3.4.3"
                Agent = "Mozilla/5.0 (compatible; Konqueror/3.4; FreeBSD) KHTML/3.4.3 (like Gecko)"
            Case "Opera 7.x"
                Agent = "Opera/7.x (Windows NT 5.1; U) [en]"
            Case "Safari 2.0"
                Agent = "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/412 (KHTML, like Gecko) Safari/412"
            Case "Firefox 1.6"
                Agent = "Mozilla/5.0 (Windows; U; Windows NT 5.0; en-US; rv:1.9a1) Gecko/20051102 Firefox/1.6a1"
            Case Else
                Agent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
        End Select
 
        SaveSetting App.EXEName, "Login", "Username", txtUser.Text
        SaveSetting App.EXEName, "Login", "Password", txtPass.Text
 
        Label1.Caption = "Logging in..."
        DPage = Wrapper1.PostWrapper("http://www.neopets.com/login.phtml", "username=" & txtUser & "&password=" & txtPass & "&destination=/petcentral.phtml", "http://www.neopets.com/hi.phtml")
 
        If (InStrB(1, DPage, "Location: /petcentral.phtml")) Then
            Label1.Caption = "Successful login"
 
            DPage = Wrapper1.GetWrapper("http://www.neopets.com/quickref.phtml", Wrapper1.LastPage)
            CheckMyPet
            'Logged in, do whatever you want now
            'Me.Hide
            'frmProgram.Show
 
        ElseIf (InStrB(1, DPage, "FROZEN")) Then
            Label1.Caption = "FROZEN :'("
 
        ElseIf (InStrB(1, DPage, "badpassword")) Then
            Label1.Caption = "Invalid password"
 
        End If
    End If
End Sub
Private Sub CheckMyPet()
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim Pet As String
 
    lngStart = InStr(1, DPage, "Pet : <a class=tl href=/quickref.phtml>")
 
    If lngStart = 0 Then: Exit Sub
        lngStart = lngStart + Len("Pet : <a class=tl href=/quickref.phtml>")
        lngEnd = InStr(lngStart, DPage, "</a>")
 
    If lngEnd = 0 Then: Exit Sub
        Pet = Mid(DPage, lngStart, lngEnd - lngStart)
 
    Label13.Caption = "Active Neopet: " & Pet
 
End Sub
 
 
 
Private Sub Text4_Change()
Timer1.Interval = Text4.Text
Timer2.Interval = Text4.Text
Timer3.Interval = Text4.Text
End Sub
Private Sub Timer1_Timer()
Dim RandNum As Integer
RandNum = rand(0, List1.ListCount)
Text6.Text = List1.List(RandNum)
Label10.Caption = Label10.Caption + 1
Text9 = Inet1.OpenURL(Text6.Text)
If InStr(Text9, "Something Has") Then
Label12.Caption = Label12.Caption + 1
End If
End Sub
Private Sub Timer2_Timer()
Dim RandNum As Integer
RandNum = rand(0, List2.ListCount)
Text7.Text = List2.List(RandNum)
Label10.Caption = Label10.Caption + 1
Text10 = Inet2.OpenURL(Text7.Text)
If InStr(Text10, "Something Has") Then
Label12.Caption = Label12.Caption + 1
End If
End Sub
Private Sub Timer3_Timer()
Dim RandNum As Integer
RandNum = rand(0, List3.ListCount)
Text8.Text = List3.List(RandNum)
Label10.Caption = Label10.Caption + 1
Text11 = Inet3.OpenURL(Text8.Text)
If InStr(Text11, "Something Has") Then
Label12.Caption = Label12.Caption + 1
End If
End Sub
Private Sub txtPass_GotFocus()
    txtPass.SelStart = 0
    txtPass.SelLength = Len(txtPass)
End Sub
Private Sub txtUser_GotFocus()
    txtUser.SelStart = 0
    txtUser.SelLength = Len(txtUser)
End Sub