Realisierung eines Popupkillers

Schritt 1: Alle Fenster suchen  

Das Prinzip eines Popupkillers ist ziemlich einfach: Wir suchen uns alle Fenster, die es gibt, und lesen deren Titel aus, anschließend wird dieser mit einer Datenbank verglichen und wenn es sich dabei um Werbung handeln sollte, wird das Fenster mittels API wieder geschlossen

Also beginnen wir damit, alle Fenster zu enumerieren.
Dafür brauchen wir:

• ein Modul (modCallback)
• ein Formular (frmMain)
• einen Timer (tmrMain, inteval=1000)
• ein Label (lblText, caption="Zuletzt geschlossene Fenster")
• eine Listbox (lstClosed)
• ein Commandbutton (cmdHide, caption="Verstecken")
• eine Picturebox (picIcon, visible=False, mit einem Icon)

Das werden alle Steuerelemente sein, die wir brauchen. Später kommt noch eine Textdatei hinzu, in der wir die "Verbotenen Überschriften" speichern

Nun zum Code:

Option Explicit

Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc _
    As Long, ByVal lParam As Long) As Boolean


Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean

End Function

Listing 1: Alle Fenster suchen, das Modul

Option Explicit

Private Sub tmrMain_Timer()
    EnumWindows AddressOf EnumWindowsProc, ByVal 0
End Sub

Listing 2: Alle Fenster suchen, das Formular

Viel tut der Code jetzt noch nicht, aber ein Ansatz ist geschaffen!

Schritt 2: Die Verbotene Liste Laden  

Mit "verbotener Liste" ist eine Liste von Worten gemeint, die in der Titelleiste nicht stehen dürfen. Diese speichern wir in der Datei "forbidden.txt". Speichern kann man diese Liste auf sehr viele Arten. Es wäre zB eine Collection möglich. Ich habe mich hier für die faulste Methode entschieden. Unser Code sieht jetzt so aus:

Dim FList() As String

Listing 3: Erweiterung des Deklarationsteils im Modul

Private Sub Form_Load()
    Dim APath As String '-Der Pfad unseres Programms
    
    'Den Pfad auslesen und ein "\" anhängen, wenn nötig
    APath = App.path
    If Right(APath, 1) <> "\" Then APath = APath & "\"
          
      'Die Liste einlesen
      Open APath & "forbidden.txt" For Input As #1
          FList = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
End Sub

Listing 4: Das Laden der "forbidden List"

Neu hinzugekommen ist ein Array namens FList, das alle verbotenen Strings speichert. Außerdem wird nun beim Laden des Programms der Pfad ermittelt, in dem sich unser Programm befindet. In diesem Ordner wird dann unsere Datei geöffnet, die die Captions der zu schließenden Fenster beinhaltet.

Die nachfolgende Zeile hat es in sich: Der komplette Inhalt wird eingelesen, und nach vbCrLf, also nach Zeilenumbrüche "gesplittet". Das dadurch entstehende Array wird in dem Array FList gespeichert.

Schritt 3: Die Fenstertitel suchen und vergleichen, Fenster schließen  

Für diese Operationen muss der Deklarationsbereich in unserem Modul um folgende Zeilen ergänzt werden:

Private Declare Function GetWindowTextLength Lib "user32" _
    Alias "GetWindowTextLengthA" (ByVal hwnd As Long) _
    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 Declare Function SendNotifyMessage Lib "user32" _
    Alias "SendNotifyMessageA" (ByVal hwnd As Long, _
    ByVal msg As Long, ByVal wParam As Long, ByVal _
    lParam As Long) As Long
        
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060

Listing 5: Ergänzungen im Deklarations-Abschnitt

'Diese Funktion wird für jedes gefundene Fenster ausgeführt
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
    Dim r As Long       '-tempoäre Variable
    Dim i As Integer    '-Zähler
    Dim titel As String '-Fenstertitel
        
    '...wir suchen den Titel...
    r = GetWindowTextLength(hwnd) + 1
    titel = Space$(r)
    r = GetWindowText(hwnd, titel, r)
    titel = Left$(titel, Len(titel) - 1)
    
            
    '...und schließen es, wenn es nötig ist...
    If InStr(titel, "Microsoft Internet Explorer") > 0 Then
        For i = 0 To UBound(FList) - 1
            If InStr(1, titel, FList(i), vbTextCompare) > 0 Then
                Call SendNotifyMessage(hwnd, WM_SYSCOMMAND, SC_CLOSE, 0)
                frmMain.lstClosed.AddItem titel, 0
                If frmMain.lstClosed.ListCount = 10 Then frmMain.lstClosed.RemoveItem 10
                Exit For
            End If
        Next i
    End If
  
    EnumWindowsProc = True
End Function

Listing 6: Die FunKtion EnumwindowsProc

Zuerst wird der Titel ermittelt. Sollte es sich dabei nicht um den IE handeln, machen wir gleich mit dem nächsten weiter.
Wenn es aber doch der IE ist, prüfen wir in einer Schleife, ob der Titel einen Ausdruck aus unserer Liste enthält. Wenn ja, wird das Fenster per API geschlossen

Zu guter Letzt fügen wir den Namen des geschlossenen Fensters in die Listbox ein und sorgen dafür, dass die Liste nicht zu lange wird.

Schritt 4: Das Formular verstecken  

Zum Schluss zeige ich noch, wie man das doch manchmal etwas nervige Formular verstecken kann!
Dazu muss einmal mehr der Deklarationsteil ergänzt werden:

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
    Alias "Shell_NotifyIconA" _
    (ByVal dwMessage As Long, IpData As NOTIFYICONDATA) As Long

Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    UFlags As Long
    uCallbackmessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Dim t As NOTIFYICONDATA

Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200

Listing 7: Die letzte Ergänzung des Deklarationsteiles

Nun folgt der Code der Schaltfläche, mit der man das Fenster ausblenden kann:

Private Sub cmdHide_Click()
    t.cbSize = Len(t)
    t.hwnd = picIcon.hwnd
    t.uID = 1&
    t.UFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
    t.uCallbackmessage = WM_MOUSEMOVE
    t.hIcon = picIcon.Picture
    t.szTip = "Popupkiller" & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    Me.Hide
End Sub

Listing 8: cmdHide_Click

Und der Code zum wieder einblenden:

Private Sub picIcon_MouseMove(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)
    
    If Hex(X) = "1E0F" Or Hex(X) = "1E2D" Then
        Me.Show
        Me.SetFocus
        Shell_NotifyIcon NIM_DELETE, t
    End If
End Sub

Listing 9: Das Wiedereinblenden des Fensters

Fertig! Jetzt kann das ungestörte Surfen losgehen!

Download  

Hier gibt es den fertigen Popupkiller als Download:

Projekt als Download [8750 Bytes]

Ihre Meinung  

Falls Sie Fragen zu diesem Tutorial haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.