[VB.NET] VirusTotal API Scan Engine

[HackTec]

Info
DE
Multi-API-Support (Maximale Geschwindigkeit): Erlaubt das Hinterlegen unbegrenzter API-Schlüssel. Das System rotiert die Keys automatisch nach jeweils 4 Dateien. Dadurch werden Ratenbegrenzungen (Rate-Limits) umgangen und die Scan-Geschwindigkeit vervielfacht.

Smart-Check (SHA-256): Berechnet zuerst den digitalen Fingerabdruck der Datei. Ist die Datei bei VirusTotal bereits bekannt, liegt das Ergebnis sofort ohne Upload vor (spart Zeit und Bandbreite).

Automatischer Upload & Polling: Unbekannte Dateien werden vollautomatisch hochgeladen. Das Tool überwacht den Analyse-Status im Hintergrund, bis das finale Ergebnis feststeht.

Parallele Verarbeitung: Verarbeitet mehrere Dateien gleichzeitig. Ein integrierter Schutzmechanismus (Semaphore) drosselt die Anfragen so, dass keine IP-Sperren oder Server-Blockaden entstehen.

System-Tray-Modus: Minimiert sich beim Klick auf das "Minus"-Symbol direkt in den Infobereich der Taskleiste (neben die Uhr), um ungestört im Hintergrund weiterzuarbeiten.

Konfiguration
Erstelle eine Textdatei namens VTAPI.txt im Ordner des Programms.

Trage dort deine API-Schlüssel ein (ein Schlüssel pro Zeile).

Das Programm lädt und rotiert die Schlüssel beim Start automatisch.

EN
Multi-API Support (Maximum Speed): Allows you to store an unlimited number of API keys. The system automatically rotates the keys after every four files. This bypasses rate limits and multiplies scanning speed.

Smart Check (SHA-256): First calculates the file's digital fingerprint. If the file is already known to VirusTotal, the result is available immediately without an upload (saving time and bandwidth).

Automatic Upload & Polling: Unknown files are uploaded fully automatically. The tool monitors the analysis status in the background until the final result is available.

Parallel Processing: Processes multiple files simultaneously. An integrated protection mechanism (semaphore) throttles requests to prevent IP bans or server blocks.

System Tray Mode: Minimizes to the taskbar notification area (next to the clock) when the "minus" icon is clicked, allowing it to continue working undisturbed in the background.

Configuration
Create a text file named VTAPI.txt in the program folder.

Enter your API keys there (one key per line).

The program automatically loads and rotates the keys upon startup.

Tipp
DE
Erstellen Sie am besten 4 bis 8 VirusTotal-Accounts, um das tägliche Scan-Volumen zu maximieren. Regulär ist der Zugriff auf 4 Anfragen pro Minute beschränkt. Das standardmäßige Tageskontingent liegt bei 500 Abfragen pro Tag.
EN
It is best to create 4 to 8 VirusTotal accounts to maximize your daily scan volume. Access is typically limited to 4 requests per minute, and the standard daily quota is 500 queries.


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


Download



Source

 Spoiler

Imports System.Drawing.Drawing2D
Imports System.IO
Imports System.Net.Http
Imports System.Net.Http.Headers
Imports System.Security.Cryptography
Imports System.Text
Imports System.Threading
Imports System.Threading.Tasks
Imports Newtonsoft.Json.Linq

Public Class VTS

' Dynamische Liste für die Keys statt festem Array
Private ReadOnly VT_KEYS As New List(Of String)()

' Anzahl Dateien pro Key bevor gewechselt wird
Private ReadOnly FilesPerKeyLimit As Integer = 4
' Rotation-Status (gemeinsame Variablen)
Private currentKeyIndex As Integer = 0
Private filesScannedWithCurrentKey As Integer = 0
Private scannedFilesCounter As Integer = 0

' Lock für thread-sichere Key-Rotation
Private ReadOnly keyLock As New Object()

' UI Ring & Fortschritt
Private ShowBigRing As Boolean = False
Private progressValue As Integer = 0
Private progressMax As Integer = 72

Private ReadOnly http As HttpClient = New HttpClient()
Dim scanTasks As New List(Of Task)()

#Region "Konstanten"
Const WM_SYSCOMMAND As Int32 = &H112
Const SC_MINIMIZE As Int32 = &HF020
#End Region

Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = WM_SYSCOMMAND AndAlso m.WParam.ToInt32() = SC_MINIMIZE Then
RaiseEvent Minimize(New EventArgs())
End If
End Sub

Public Event Minimize(ByVal e As EventArgs)

Private Sub Me_Minimize(ByVal e As EventArgs) Handles Me.Minimize
Me.WindowState = FormWindowState.Minimized
Me.ShowInTaskbar = False
Me.Hide()
End Sub

Private Sub NotifyIcon1_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
Me.WindowState = FormWindowState.Normal
Me.ShowInTaskbar = True
Me.TopMost = True
Me.Show()
End Sub

Private Sub NotifyIcon1_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs) Handles NotifyIcon1.MouseClick
Me.WindowState = FormWindowState.Normal
Me.ShowInTaskbar = True
Me.TopMost = True
Me.Show()
End Sub

Private Sub VTS_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' ListView Setup falls nicht im Designer gesetzt
If FilesScannedFinal.Columns.Count = 0 Then
FilesScannedFinal.View = View.Details
FilesScannedFinal.Columns.Add("FileName", 320)
FilesScannedFinal.Columns.Add("Score", 100)
End If

' Laden der Keys aus der VTAPI.txt im Anwendungsordner
Dim filePath As String = Path.Combine(Application.StartupPath, "VTAPI.txt")

Try
If File.Exists(filePath) Then
Dim lines = File.ReadAllLines(filePath)
For Each line In lines
Dim trimmedKey = line.Trim()
' Nur hinzufügen, wenn die Zeile nicht leer ist
If Not String.IsNullOrWhiteSpace(trimmedKey) Then
VT_KEYS.Add(trimmedKey)
End If
Next

LogConsole($"{VT_KEYS.Count} API-Keys erfolgreich aus VTAPI.txt geladen.")
Else
' Falls die Datei nicht existiert, erstellen wir eine leere Vorlage
File.WriteAllText(filePath, "")
MessageBox.Show("Die Datei 'VTAPI.txt' wurde nicht gefunden. Eine leere Datei wurde im Programmpfad erstellt. Bitte trage dort deine Keys ein (ein Key pro Zeile).", "Keys fehlen", MessageBoxButtons.OK, MessageBoxIcon.Warning)
End If
Catch ex As Exception
MessageBox.Show("Fehler beim Laden der VTAPI.txt: " & ex.Message, "Fehler", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try

If VT_KEYS.Count = 0 Then
LogConsole("Warnung: Keine API-Keys geladen! Scans werden fehlschlagen.")
End If
End Sub

Public Sub FinalVirusScore()
progressValue = 0
ShowBigRing = False
Me.Invalidate()
End Sub

Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
If Not ShowBigRing Then Return

Dim g As Graphics = e.Graphics
g.SmoothingMode = SmoothingMode.AntiAlias

Dim thickness As Integer = 10
Dim rect As New Rectangle(5, 5, 70, 70)

Using penBack As New Pen(Color.FromArgb(50, 60, 100), thickness)
penBack.StartCap = LineCap.Round
penBack.EndCap = LineCap.Round
g.DrawArc(penBack, rect, -90, 360)
End Using

Dim sweep As Single = 360.0F * progressValue / progressMax
Using penProg As New Pen(Color.Red, thickness)
penProg.StartCap = LineCap.Round
penProg.EndCap = LineCap.Round
g.DrawArc(penProg, rect, -90, sweep)
End Using

Dim sf As New StringFormat With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center}
Using f As New Font("Segoe UI", 20, FontStyle.Bold)
g.DrawString(progressValue.ToString(), f, Brushes.White, New PointF(40, 37), sf)
End Using

Using f2 As New Font("Segoe UI", 8)
g.DrawString("flagged this file", f2, Brushes.Coral, New PointF(40, 82), sf)
End Using
End Sub

Private Sub ChooseFiles_Click(sender As Object, e As EventArgs) Handles ChooseFiles.Click
Using dlg As New FolderBrowserDialog()
If dlg.ShowDialog() = DialogResult.OK Then
FolderPath.Text = dlg.SelectedPath
PopulateFilesList(dlg.SelectedPath)
End If
End Using
End Sub

Private Sub PopulateFilesList(folder As String)
If FilesforScan Is Nothing Then Return
FilesforScan.Items.Clear()
Try
Dim files = Directory.GetFiles(folder)
For Each f In files
FilesforScan.Items.Add(Path.GetFileName(f))
Next
Catch ex As Exception
MessageBox.Show("Fehler beim Lesen des Ordners: " & ex.Message)
End Try
End Sub

Dim AnimationsBildEnabled As Boolean = True

Private Async Sub AnimationsBild_Click(sender As Object, e As EventArgs) Handles AnimationsBild.Click
If Not AnimationsBildEnabled Then Return

If VT_KEYS.Count = 0 Then
MessageBox.Show("Es wurden keine API-Keys geladen. Bitte trage Keys in die 'VTAPI.txt' ein.", "Fehler", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
End If

If FilesforScan Is Nothing OrElse FilesforScan.Items.Count = 0 Then
MessageBox.Show("Keine Dateien zum Scannen.")
Return
End If

AnimationsBild.BackgroundImage = Nothing
AnimationsBild.Image = My.Resources.Bscanworkingfast

AnimationsBildEnabled = False

If FilesScannedFinal IsNot Nothing Then FilesScannedFinal.Items.Clear()
ShowBigRing = True
progressValue = 0
progressMax = 72
Me.Invalidate()

SyncLock keyLock
currentKeyIndex = 0
filesScannedWithCurrentKey = 0
scannedFilesCounter = 0
End SyncLock

Dim tasks As New List(Of Task)()

For i = 0 To FilesforScan.Items.Count - 1
Dim filename As String = FilesforScan.Items(i).ToString()
Dim fullPath = Path.Combine(FolderPath.Text, filename)

tasks.Add(Task.Run(Async Function()
Dim lvi As New ListViewItem(filename)
lvi.SubItems.Add("...")

Me.Invoke(Sub()
If FilesScannedFinal IsNot Nothing Then FilesScannedFinal.Items.Add(lvi)
End Sub)

Dim apiKey = GetApiKeyForNextFile()
Dim score As String
If String.IsNullOrWhiteSpace(apiKey) Then
score = "NoKey"
LogConsole($"Kein API-Key verfügbar für {filename}")
Me.Invoke(Sub() APITryLabel.Text = "(no key)")
Else
Me.Invoke(Sub()
APITryLabel.Text = MaskKey(apiKey)
End Sub)
LogConsole($"Verwende API-Key {MaskKey(apiKey)} für {filename}")
score = Await ScanFileAndGetScoreAsync(fullPath, apiKey)
End If

Me.Invoke(Sub() lvi.SubItems(1).Text = score)
Dim totalScanned = Interlocked.Increment(scannedFilesCounter)
Me.Invoke(Sub() APIScannedLabel.Text = totalScanned.ToString())

End Function))
Next

Await Task.WhenAll(tasks)

ShowBigRing = False
Me.Invalidate()
AnimationsBildEnabled = True

AnimationsBild.Image = My.Resources.Bscanstand
End Sub

' Thread-safe GetApiKeyForNextFile (angepasst an List(Of String))
Private Function GetApiKeyForNextFile() As String
If VT_KEYS Is Nothing OrElse VT_KEYS.Count = 0 Then Return String.Empty

SyncLock keyLock
Dim attempts As Integer = 0
Dim foundKey As String = Nothing

' Falls Limit erreicht -> wechsle Key
If filesScannedWithCurrentKey >= FilesPerKeyLimit Then
currentKeyIndex = (currentKeyIndex + 1) Mod VT_KEYS.Count
filesScannedWithCurrentKey = 0
LogConsole($"API-Key gewechselt: {MaskKey(VT_KEYS(currentKeyIndex))} (Index {currentKeyIndex})")
End If

' Suche ersten nicht-leeren Key (max VT_KEYS.Count Versuche)
While attempts < VT_KEYS.Count
Dim k = VT_KEYS(currentKeyIndex)
If Not String.IsNullOrWhiteSpace(k) Then
foundKey = k
Exit While
End If
currentKeyIndex = (currentKeyIndex + 1) Mod VT_KEYS.Count
attempts += 1
End While

If String.IsNullOrWhiteSpace(foundKey) Then
Return String.Empty
End If

filesScannedWithCurrentKey += 1
Return foundKey
End SyncLock
End Function

Private Async Function ScanFileAndGetScoreAsync(filePath As String, apiKey As String) As Task(Of String)
Try
Dim bytes As Byte() = Await Task.Run(Function() File.ReadAllBytes(filePath))
Dim sha256 = ComputeSHA256(bytes)
Dim fileNameOnly = Path.GetFileName(filePath)

LogConsole($"Prüfe Vorhandensein auf VT für {fileNameOnly} (SHA256 {sha256})")
Dim fileInfoUrl = $"https://www.virustotal.com/api/v3/files/{sha256}"

Dim resp = Await SendGetAsync(fileInfoUrl, apiKey)
If resp IsNot Nothing AndAlso resp.IsSuccessStatusCode Then
Dim txt = Await resp.Content.ReadAsStringAsync()
UpdateProgressFromFileJson(txt)
Dim score = ParseScoreFromFileJson(txt)
LogConsole($"Vorhanden: {fileNameOnly} -> {score}")
Return score
End If

' Upload
LogConsole($"Upload startet für {fileNameOnly}")
Using content As New MultipartFormDataContent()
Dim ba As New ByteArrayContent(bytes)
ba.Headers.ContentType = New MediaTypeHeaderValue("application/octet-stream")
content.Add(ba, "file", fileNameOnly)

Dim upResp = Await SendPostAsync("https://www.virustotal.com/api/v3/files", content, apiKey)
If upResp Is Nothing Then
LogConsole($"Upload fehlgeschlagen (no response) für {fileNameOnly}")
Return "UploadFail"
End If

Dim upText = Await upResp.Content.ReadAsStringAsync()
If Not upResp.IsSuccessStatusCode Then
LogConsole($"Upload fehlgeschlagen ({upResp.StatusCode}) für {fileNameOnly}")
Return $"UploadFail ({upResp.StatusCode})"
End If

Dim upJson = JObject.Parse(upText)
Dim analysisId = upJson.SelectToken("data.id")?.ToString()
LogConsole($"Upload OK für {fileNameOnly} - Analysis ID: {analysisId}")
If String.IsNullOrEmpty(analysisId) Then
LogConsole($"Keine Analysis-ID für {fileNameOnly}")
Return "NoAnalysisID"
End If

Dim analysisUrl = $"https://www.virustotal.com/api/v3/analyses/{analysisId}"
Dim lastStatus As String = String.Empty

For i = 1 To 30
Await Task.Delay(1500)
Dim aResp = Await SendGetAsync(analysisUrl, apiKey)
If aResp Is Nothing Then Continue For
If Not aResp.IsSuccessStatusCode Then
If aResp.StatusCode = CType(429, Net.HttpStatusCode) Then
LogConsole($"Rate-Limit beim Polling für {fileNameOnly}, warte...")
Await Task.Delay(5000)
End If
Continue For
End If
Dim aText = Await aResp.Content.ReadAsStringAsync()
Dim status = JObject.Parse(aText).SelectToken("data.attributes. status")?.ToString()
If status <> lastStatus Then
LogConsole($"Analyse-Status {fileNameOnly}: {status}")
lastStatus = status
End If
If status = "completed" Then Exit For
Next

Dim fResp2 = Await SendGetAsync(fileInfoUrl, apiKey)
If fResp2 IsNot Nothing AndAlso fResp2.IsSuccessStatusCode Then
Dim fText = Await fResp2.Content.ReadAsStringAsync()
UpdateProgressFromFileJson(fText)
Dim score = ParseScoreFromFileJson(fText)
LogConsole($"Analyse fertig für {fileNameOnly} -> {score}")
Return score
Else
LogConsole($"Analyse fertig, aber /files fehlgeschlagen für {fileNameOnly}")
Return $"AnalyseOk, aber /files fehlgeschl"
End If
End Using

Catch ex As Exception
LogConsole($"Fehler beim Scannen von {Path.GetFileName(filePath)}: {ex.Message}")
Return "Err: " & ex.Message
End Try
End Function

Private Sub LogConsole(message As String)
Dim time = DateTime.Now.ToString("yyyy-MM-dd HH:mm:ss")
Dim line = $"{time} - {message}{Environment.NewLine}"
If ConsoleAnzeige Is Nothing Then Return
If ConsoleAnzeige.InvokeRequired Then
ConsoleAnzeige.Invoke(Sub() ConsoleAnzeige.AppendText(line))
Else
ConsoleAnzeige.AppendText(line)
End If
End Sub

Private Function MaskKey(k As String) As String
If String.IsNullOrWhiteSpace(k) Then Return "(no key)"
If k.Length <= 8 Then Return k
Return $"{k.Substring(0, 4)}...{k.Substring(k.Length - 4)}"
End Function

Private Async Function SendGetAsync(url As String, apiKey As String) As Task(Of HttpResponseMessage)
Dim retries = 0
Dim delayMs As Integer = 1000
While retries < 5
Dim hadException As Boolean = False
Try
Using req As New HttpRequestMessage(HttpMethod.Get, url)
req.Headers.Clear()
req.Headers.Add("x-apikey", apiKey)
Dim resp = Await http.SendAsync(req)
If resp.StatusCode = CType(429, Net.HttpStatusCode) Then
retries += 1
Await Task.Delay(delayMs)
delayMs *= 2
Continue While
End If
Return resp
End Using
Catch
hadException = True
retries += 1
End Try

If hadException Then
Await Task.Delay(delayMs)
delayMs *= 2
End If
End While

Return Nothing
End Function

Private Async Function SendPostAsync(url As String, content As HttpContent, apiKey As String) As Task(Of HttpResponseMessage)
Dim retries = 0
Dim delayMs As Integer = 1000
While retries < 5
Dim hadException As Boolean = False
Try
Using req As New HttpRequestMessage(HttpMethod.Post, url)
req.Headers.Clear()
req.Headers.Add("x-apikey", apiKey)
req.Content = content
Dim resp = Await http.SendAsync(req)
If resp.StatusCode = CType(429, Net.HttpStatusCode) Then
retries += 1
Await Task.Delay(delayMs)
delayMs *= 2
Continue While
End If
Return resp
End Using
Catch
hadException = True
retries += 1
End Try

If hadException Then
Await Task.Delay(delayMs)
delayMs *= 2
End If
End While

Return Nothing
End Function

Private Function ParseScoreFromFileJson(jsonText As String) As String
Try
Dim j = JObject.Parse(jsonText)
Dim results = j.SelectToken("data.attributes.last_analysis_resul ts")
If results Is Nothing Then Return "0//0"
Dim total = 0, positives = 0
For Each p As JProperty In results
total += 1
Dim category = p.Value.SelectToken("category")?.ToString()
If category IsNot Nothing AndAlso category <> "undetected" Then positives += 1
Next
Return $"{positives}//{total}"
Catch
Return "parseErr"
End Try
End Function

Private Sub UpdateProgressFromFileJson(jsonText As String)
Try
Dim j = JObject.Parse(jsonText)
Dim results = j.SelectToken("data.attributes.last_analysis_resul ts")
If results Is Nothing Then Return
Dim total = 0, positives = 0
For Each p As JProperty In results
total += 1
Dim category = p.Value.SelectToken("category")?.ToString()
If category IsNot Nothing AndAlso category <> "undetected" Then positives += 1
Next
progressMax = If(total > 0, total, 72)
Me.Invoke(Sub()
progressValue = positives
Me.Invalidate()
End Sub)
Catch
End Try
End Sub

Private Function ComputeSHA256(bytes() As Byte) As String
Using sha = SHA256.Create()
Dim hash = sha.ComputeHash(bytes)
Dim sb As New StringBuilder()
For Each b In hash
sb.Append(b.ToString("x2"))
Next
Return sb.ToString()
End Using
End Function

Private Sub FilesForScan_DoubleClick(sender As Object, e As EventArgs) Handles FilesforScan.DoubleClick
If FilesforScan.SelectedIndex >= 0 Then
FilesforScan.Items.RemoveAt(FilesforScan.SelectedI ndex)
End If
End Sub

End Class