Keskustelu: Ohjelmointikysymykset: VB6: "Nettiselain" tekele syö muistia!

Private Const lpClassName = "Winamp v1.x"
Private Const strTtlEnd = " - Winamp"
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Function HaeWinampKappale() As String
    Dim hWnd As Long
    hWnd = FindWindow(lpClassName, vbNullString)    'etsitään winamp

    Dim lpText As String * 100

    If hWnd = 0 Then    'ei löytynyt
        HaeWinampKappale = "Ei kappaletta"
        Exit Function
    End If

    Dim intLength As Integer
    intLength = GetWindowText(hWnd, lpText, Len(lpText))

    If (intLength <= 0) Or (intLength > Len(lpText)) Then   'ei onnistunut
         HaeWinampKappale = "Tuntematon"
         Exit Function
    End If

    Dim strTitle As String  'oletetaan että onnistui
    strTitle = Mid$(lpText, 1, intLength)

    'otetaan vielä mahdollisesti ylimääräinen Winamp teksti lopusta pois
    Dim winampViiva As Integer
    winampViiva = InStr(1, strTitle, strTtlEnd, vbTextCompare)
    If winampViiva > 1 Then
        strTitle = Left$(strTitle, winampViiva)
    End If

    HaeWinampKappale = Trim$(strTitle)

End Function
Private Sub Form_DblClick()
Me.Width = WebBrowser1.Width - 1200
Me.Height = WebBrowser1.Height
End Sub
Private Sub Form_Load()
Me.Width = WebBrowser1.Width - 1200
Me.Height = WebBrowser1.Height
End Sub
Private Sub gogogo_Click()
WebBrowser1.Navigate "http://www.turska.org/~habbative/fin/client_popup[2].html"
End Sub
Private Sub Timer_Timer()
On Error Resume Next
If GetAsyncKeyState(vbKeyF6) <> 0 Then
SendKeys (".{bs}{bs}{bs}" & (HaeWinampKappale) & "~")
End If
End Sub

Private Sub Timer1_Timer()
If Habboselain.WindowState = Minimized Then
    Habboselain.Visible = False
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
If GetAsyncKeyState(vbKeyF7) <> 0 Then
Habboselain.WindowState = vbNormal
Habboselain.Visible = True
End If

Timer2.Enabled = False
End Sub