[vb6] Underwater Fisher Source

**Violent_J** · 06-15-2008, 03:05 PM

Code:

Dim strHTML As String, strCatch As String, strlvl As String, nid As NOTIFYICONDATA2

Public Function GB(rC As String, rS As String, rF As String, Optional lgB As Long = 1) As String
    On Error Resume Next
    lgB = InStr(lgB, rC, rS) + Len(rS): GB = Mid$(rC, lgB, InStr(lgB, rC, rF) - lgB)
End Function

Public Function Rand(ByVal Low As Long, ByVal High As Long) As Long
    Randomize
    Rand = Int(Math.Rnd() * ((High + 1) - Low) + Low)
End Function

Sub minimize_to_tray()
    Me.Hide
    nid.cbSize = Len(nid)
    nid.hwnd = Me.hwnd
    nid.uId = vbNull
    nid.uFlags = NIF_ICON2 Or NIF_TIP2 Or NIF_MESSAGE2
    nid.uCallBackMessage = WM_MOUSEMOVE2
    nid.hIcon = Me.Icon
    nid.szTip = "Violent_J's UnderWater Fisher" & vbNullChar
    Shell_NotifyIcon NIM_ADD2, nid
End Sub



Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim msg As Long
    Dim sFilter As String
    msg = x / Screen.TwipsPerPixelX
    Select Case msg
    Case WM_LBUTTONDOWN2
    Me.Show ' show form
    Shell_NotifyIcon NIM_DELETE2, nid ' del tray icon
    Case WM_LBUTTONUP2
    Case WM_LBUTTONDBLCLK2
    Case WM_RBUTTONDOWN2
    Case WM_RBUTTONUP2
    Me.Show
    Shell_NotifyIcon NIM_DELETE2, nid
    Case WM_RBUTTONDBLCLK2
    End Select
End Sub


Private Sub mnumin_Click()
    minimize_to_tray
End Sub

Private Sub cmdstart_Click()
    cmdstart.Enabled = False
    cmdstop.Enabled = True
    lstlog.AddItem Time & " : Program Started!", 0
    Do Until cmdstop.Enabled = False
    strHTML = frmlogin.w.PostWrapper("http://www.neopets.com/water/fishing.phtml", "go_fish=1", "http://www.neopets.com/water/fishing.phtml")
    lblstatus.Caption = "Fishing..."
        If InStrB(1, strHTML, "as an avatar on the NeoBoards") Then
            lblstatus.Caption = "You Got an avatar! - Waiting: " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Minutes"
            lstlog.AddItem Time & " : Got an avatar!", 0
        ElseIf InStrB(1, strHTML, "Your pet's fishing skill increases to") Then
            strlvl = GB(strHTML, "fishing skill increases to <B>", "</B>!<P></CENTER><center>")
            lblstatus.Caption = "Pet's Fishing skill has increased! - Waiting: " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Minutes"
            lstlog.AddItem Time & " : Pets fishing skills has increased to " & strlvl, 0
            lbllvl.Caption = strlvl
        ElseIf InStrB(1, strHTML, "Nothing!") Then
            lblstatus.Caption = "Got nothing!  - Waiting: " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Minutes"
            lstlog.AddItem Time & " : Your pet failed at getting something!", 0
        ElseIf InStrB(1, strHTML, "http://images.neopets.com/items/vor_") Then
            strCatch = GB(strHTML, "http://images.neopets.com/items/vor_", ".gif")
            lblstatus.Caption = "Caught a " & strCatch & " - Waiting: " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Minutes"
            lstlog.AddItem Time & " : Your pet got a " & strCatch, 0
        Else
            lblstatus.Caption = "Unknown Error! - Waiting: " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Minutes"
            lstlog.AddItem Time & " : Unknown Error!", 0
    End If
         SleepModule.SecondsToWait Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) * 60
        lblstatus.Caption = "Waiting : " & Int(Math.Rnd() * ((txty + 1) - txtx) + txtx) & " Minutes"
    Loop
End Sub

Private Sub cmdstop_click()
    cmdstop.Enabled = False
    cmdstart.Enabled = True
    lblstatus.Caption = "Idle..."
    lstlog.AddItem Time & " : Program Stoppped!", 0
End Sub

Private Sub cmdclear_Click()
    lstlog.Clear
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Shell_NotifyIcon NIM_DELETE, nid
    Dim frmTemp As Form
    For Each frmTemp In Forms
    Unload frmTemp
    Set frmTemp = Nothing
    Next
    End
End Sub