[VB.NET] Spotify DNS Custom Ad-Blocker (Local)

[HackTec]

Creditz and Idea go to Hiruko Fumiko:



========================================








========================================

Download




Source

 Spoiler

Imports System.IO
Imports System.Security.Principal
Imports System.Diagnostics

Public Class Form1

'////////////////////////////////////////////////////// Minimier event
#Region "Konstanten"
Const WM_SYSCOMMAND As Int32 = &H112
Const SC_MINIMIZE As Int32 = &HF020
#End Region




' Pfad zur Hosts-Datei unter Berücksichtigung von 32/64-Bit Umleitungen
Private Shared ReadOnly HostsPath As String = GetHostsPath()

' Eindeutige Marker für das sichere Einfügen und Entfernen
Private Const StartMarker As String = "# Begin SpoTLock AdBlock"
Private Const EndMarker As String = "# End SpoTLock AdBlock"

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' Checkboxen mit den Domains aus dem Screenshot befüllen
InitDomainLists()

' Timer konfigurieren (Intervall: 2 Sekunden)
TIM.Interval = 2000
TIM.Start()

' Ersten Status-Check beim Laden durchführen
UpdateStatusUI()

NotifyIcon1.Visible = True ' Aktiviert das Icon im System-Tray
End Sub


' Erkennt, wenn das Fenster minimiert wird, und versteckt es aus der Taskleiste
Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize
If Me.WindowState = FormWindowState.Minimized Then
Me.Hide() ' Versteckt das Fenster vollständig
End If
End Sub

' Holt das Fenster per Doppelklick auf das System-Tray-Icon wieder in den Vordergrund
Private Sub NotifyIcon1_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
Me.Show() ' Macht das Fenster wieder sichtbar
Me.WindowState = FormWindowState.Normal ' Setzt den Fensterzustand zurück auf Normal
Me.Activate() ' Fokussiert das Fenster im Vordergrund
End Sub









''' <summary>
''' Befüllt die 6 CheckedListBoxes (SBL1 bis SBL6) exakt nach Vorlage des Screenshots.
''' </summary>
Private Sub InitDomainLists()
' SBL1: Allgemeine Werbe- und Tracking-Netzwerke
SBL1.Items.AddRange(New String() {
"adclick.g.doubleclick.net",
"ads.doubleclick.net",
"ads.pubmatic.com",
"ads.yahoo.com",
"ads.youtube.com",
"adservice.google.com",
"gads.pubmatic.com",
"googleads.g.doubleclick.net",
"googlesyndication.com",
"pagead2.googlesyndication.com",
"pubads.g.doubleclick.net",
"securepubads.g.doubleclick.net",
"www.googletagservices.com"
})

' SBL2: Spotify Verzeichnis/Header-Strukturen
SBL2.Items.AddRange(New String() {
"heads-ak.spotify.com",
"heads-akp.spotify.com",
"heads-cf.spotify.com",
"heads-fa.scdn.co",
"heads-fa.spotify.com",
"heads-fab.spotify.com",
"heads-fac.spotify.com"
})

' SBL3: Spotify Event-Tracker & Audio-Werbe-Server
SBL3.Items.AddRange(New String() {
"adeventtracker.spotify.com",
"ads-fa.spotify.com",
"ads.spotify.com",
"audio-ads.spotify.com"
})

' SBL4: Analyse und Telemetrie (Crash-Reports)
SBL4.Items.AddRange(New String() {
"analytics.spotify.com",
"crashdump.spotify.com",
"crashdump.gate-gslb.spotify.com",
"loq.spotify.com",
"loq2.spotify.com",
"partner-service.spotify.com",
"surveys.spotify.com"
})

' SBL5: Video-Werbung und CDN-Inhalte
SBL5.Items.AddRange(New String() {
"ads-sp-lon.cdn.spotify.com",
"mp3ad.scdn.co",
"promo.spotify.com",
"video-fa.scdn.co",
"video-fa.cdn.spotify.com",
"video-fa-b.cdn.spotify.com"
})

' SBL6: Kritische Kern-API (Vorsicht beim Blockieren!)
SBL6.Items.AddRange(New String() {
"spclient.wg.spotify.com"
})

' Alle Boxen außer SBL6 standardmäßig vorauswählen
SetAllChecked(SBL1, True)
SetAllChecked(SBL2, True)
SetAllChecked(SBL3, True)
SetAllChecked(SBL4, True)
SetAllChecked(SBL5, True)
SetAllChecked(SBL6, False) ' Deaktiviert lassen wegen Verbindungsabbruch
End Sub

' Button: Blocker aktivieren
Private Sub Blockerstart_Click(sender As Object, e As EventArgs) Handles BlockerStart.Click
If Not IsUserAdmin() Then
MessageBox.Show("Administratorrechte erforderlich! Bitte starten Sie Visual Studio / die Anwendung als Administrator.", "Zugriff verweigert", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If

Try
' 1. Alle ausgewählten Domains aus den 6 Listen einsammeln
Dim domainsToBlock As New List(Of String)()
Dim lists As CheckedListBox() = {SBL1, SBL2, SBL3, SBL4, SBL5, SBL6}

For Each clb As CheckedListBox In lists
For Each item In clb.CheckedItems
domainsToBlock.Add(item.ToString().Trim().ToLower( ))
Next
Next

If domainsToBlock.Count = 0 Then
MessageBox.Show("Bitte wählen Sie mindestens eine Domain aus, die blockiert werden soll.", "Keine Auswahl", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Exit Sub
End If

' 2. Aktuelle Hosts-Datei einlesen und alte Sektion filtern
Dim currentLines As List(Of String) = File.ReadAllLines(HostsPath).ToList()
Dim cleanedLines As List(Of String) = RemoveBlockerSection(currentLines)

' 3. Neue Sektion aufbauen
cleanedLines.Add(StartMarker)
For Each dom In domainsToBlock.Distinct()
cleanedLines.Add($"0.0.0.0 {dom}")
Next
cleanedLines.Add(EndMarker)

' 4. Datei schreiben & DNS Cache leeren
File.WriteAllLines(HostsPath, cleanedLines)
FlushDNS()
UpdateStatusUI()

MessageBox.Show("DNS-Blocker erfolgreich angewendet!", "Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
NotifyIcon1.Icon = My.Resources.IconIconStatusOn
Catch ex As Exception
MessageBox.Show($"Fehler beim Schreiben der Hosts-Datei: {ex.Message}", "Fehler", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub

' Button: Blocker deaktivieren
Private Sub Blockerstop_Click(sender As Object, e As EventArgs) Handles Blockerstop.Click
If Not IsUserAdmin() Then
MessageBox.Show("Administratorrechte erforderlich!", "Zugriff verweigert", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If

Try
Dim currentLines As List(Of String) = File.ReadAllLines(HostsPath).ToList()
Dim cleanedLines As List(Of String) = RemoveBlockerSection(currentLines)

File.WriteAllLines(HostsPath, cleanedLines)
FlushDNS()
UpdateStatusUI()

MessageBox.Show("Blocker deaktiviert und Einträge entfernt.", "Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
NotifyIcon1.Icon = My.Resources.IconStatusOff
Catch ex As Exception
MessageBox.Show($"Fehler beim Entfernen der Einträge: {ex.Message}", "Fehler", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub

' Timer Tick Event: Aktualisiert zyklisch die Anzeige der PictureBox
Private Sub TIM_Tick(sender As Object, e As EventArgs) Handles TIM.Tick
UpdateStatusUI()
End Sub

''' <summary>
''' Prüft den Zustand der Hosts-Datei und ändert das Bild/die Farbe der PictureBox.
''' </summary>
Private Sub UpdateStatusUI()
Dim isBlockingActive As Boolean = CheckIfBlockerIsActive()

If isBlockingActive Then
' Hier kannst du deine Grafik laden:
' Statusbild.Image = My.Resources.DeinEingeschaltetBild
StatusBild.BackgroundImage = My.Resources.BlockerOn
Else
' Statusbild.Image = My.Resources.DeinAusgeschaltetBild
StatusBild.BackgroundImage = My.Resources.BlockerOff
End If
End Sub

#Region "Hilfsfunktionen und Kernlogik"

Private Shared Function GetHostsPath() As String
Dim sysDir As String = Environment.GetFolderPath(Environment.SpecialFolde r.System)
' Verhindert die automatische Dateisystemumleitung bei 32-Bit Kompilierung auf x64 Windows
If Environment.Is64BitOperatingSystem AndAlso Not Environment.Is64BitProcess Then
sysDir = Path.Combine(Environment.GetEnvironmentVariable("W inDir"), "Sysnative")
End If
Return Path.Combine(sysDir, "drivers\etc\hosts")
End Function

Private Function IsUserAdmin() As Boolean
Dim identity As WindowsIdentity = WindowsIdentity.GetCurrent()
Dim principal As New WindowsPrincipal(identity)
Return principal.IsInRole(WindowsBuiltInRole.Administrato r)
End Function

Private Function CheckIfBlockerIsActive() As Boolean
If Not File.Exists(HostsPath) Then Return False
Try
Dim text As String = File.ReadAllText(HostsPath)
Return text.Contains(StartMarker) AndAlso text.Contains(EndMarker)
Catch
Return False
End Try
End Function

Private Function RemoveBlockerSection(lines As List(Of String)) As List(Of String)
Dim result As New List(Of String)()
Dim inBlockerSection As Boolean = False

For Each line In lines
Dim trimmed As String = line.Trim()
If trimmed.Equals(StartMarker, StringComparison.OrdinalIgnoreCase) Then
inBlockerSection = True
Continue For
End If
If trimmed.Equals(EndMarker, StringComparison.OrdinalIgnoreCase) Then
inBlockerSection = False
Continue For
End If
If Not inBlockerSection Then
result.Add(line)
End If
Next
Return result
End Function

Private Sub FlushDNS()
Try
Dim startInfo As New ProcessStartInfo("ipconfig", "/flushdns") With {
.CreateNoWindow = True,
.UseShellExecute = False,
.WindowStyle = ProcessWindowStyle.Hidden
}
Using proc As Process = Process.Start(startInfo)
proc.WaitForExit()
End Using
Catch ex As Exception
' Fehler beim DNS Flush abfangen
End Try
End Sub

Private Sub SetAllChecked(clb As CheckedListBox, checkState As Boolean)
For i As Integer = 0 To clb.Items.Count - 1
clb.SetItemChecked(i, checkState)
Next
End Sub

#End Region

End Class