' ============================================================
' KazTech Windows Malware Persistence Audit
' Windows 10 / Windows 11
'
' READ-ONLY diagnostic tool.
' Makes NO changes to the computer.
'
' Creates:
'   KazTech_Malware_Audit.txt
' on the current user's Desktop.
' ============================================================

Option Explicit

Dim fso, shell, wmi, report, reportPath
Dim desktopPath, computerName, userName

Set fso   = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("WScript.Shell")
Set wmi   = GetObject("winmgmts:\\.\root\cimv2")

desktopPath = shell.SpecialFolders("Desktop")
reportPath = desktopPath & "\KazTech_Malware_Audit.txt"

computerName = shell.ExpandEnvironmentStrings("%COMPUTERNAME%")
userName = shell.ExpandEnvironmentStrings("%USERNAME%")

Set report = fso.CreateTextFile(reportPath, True, True)

WriteLine "============================================================"
WriteLine " KAZTECH WINDOWS MALWARE PERSISTENCE AUDIT"
WriteLine "============================================================"
WriteLine ""
WriteLine "Computer: " & computerName
WriteLine "User:     " & userName
WriteLine "Date:     " & Now
WriteLine ""

GetWindowsInfo
GetStartupCommands
GetRunKeys
GetStartupFolders
GetProxySettings
GetHostsFile
GetRunningProcesses
GetAutoServices

report.Close

MsgBox "Malware audit completed." & vbCrLf & vbCrLf & _
       "Report saved to:" & vbCrLf & reportPath, _
       vbInformation, "KazTech Malware Audit"

Set report = Nothing
Set wmi = Nothing
Set shell = Nothing
Set fso = Nothing

WScript.Quit


' ============================================================
' Helper
' ============================================================

Sub WriteLine(text)
    report.WriteLine text
End Sub


' ============================================================
' Windows information
' ============================================================

Sub GetWindowsInfo()

    Dim items, item

    WriteLine "============================================================"
    WriteLine " WINDOWS INFORMATION"
    WriteLine "============================================================"

    On Error Resume Next

    Set items = wmi.ExecQuery( _
        "SELECT Caption, Version, BuildNumber, LastBootUpTime " & _
        "FROM Win32_OperatingSystem")

    For Each item In items
        WriteLine "OS:         " & item.Caption
        WriteLine "Version:    " & item.Version
        WriteLine "Build:      " & item.BuildNumber
        WriteLine "Last Boot:  " & item.LastBootUpTime
    Next

    WriteLine ""

    On Error GoTo 0

End Sub


' ============================================================
' Startup commands reported by Windows
' ============================================================

Sub GetStartupCommands()

    Dim items, item

    WriteLine "============================================================"
    WriteLine " STARTUP COMMANDS"
    WriteLine "============================================================"

    On Error Resume Next

    Set items = wmi.ExecQuery( _
        "SELECT Name, Command, Location, User FROM Win32_StartupCommand")

    For Each item In items

        WriteLine "Name:     " & SafeValue(item.Name)
        WriteLine "Command:  " & SafeValue(item.Command)
        WriteLine "Location: " & SafeValue(item.Location)
        WriteLine "User:     " & SafeValue(item.User)
        WriteLine "------------------------------------------------------------"

    Next

    WriteLine ""

    On Error GoTo 0

End Sub


' ============================================================
' Run / RunOnce registry locations
' ============================================================

Sub GetRunKeys()

    WriteLine "============================================================"
    WriteLine " RUN / RUNONCE REGISTRY KEYS"
    WriteLine "============================================================"

    ReadRegistryKey "HKCU\Software\Microsoft\Windows\CurrentVersion\Run"
    ReadRegistryKey "HKCU\Software\Microsoft\Windows\CurrentVersion\RunOnce"

    ReadRegistryKey "HKLM\Software\Microsoft\Windows\CurrentVersion\Run"
    ReadRegistryKey "HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnce"

    ReadRegistryKey "HKLM\Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Run"
    ReadRegistryKey "HKLM\Software\WOW6432Node\Microsoft\Windows\CurrentVersion\RunOnce"

    WriteLine ""

End Sub


Sub ReadRegistryKey(keyPath)

    Dim reg, hive, subKey, names, types
    Dim i, value
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002

    On Error Resume Next

    WriteLine ""
    WriteLine "[" & keyPath & "]"

    If Left(UCase(keyPath), 4) = "HKCU" Then

        Set reg = GetObject( _
            "winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

        hive = HKEY_CURRENT_USER
        subKey = Mid(keyPath, 6)

    Else

        Set reg = GetObject( _
            "winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

        hive = HKEY_LOCAL_MACHINE
        subKey = Mid(keyPath, 6)

    End If

    reg.EnumValues hive, subKey, names, types

    If IsNull(names) Then
        WriteLine "(No entries)"
        Exit Sub
    End If

    For i = 0 To UBound(names)

        value = ""
        reg.GetStringValue hive, subKey, names(i), value

        WriteLine names(i) & " = " & value

    Next

    On Error GoTo 0

End Sub


' ============================================================
' Startup folders
' ============================================================

Sub GetStartupFolders()

    Dim userStartup, commonStartup

    WriteLine "============================================================"
    WriteLine " STARTUP FOLDERS"
    WriteLine "============================================================"

    userStartup = shell.SpecialFolders("Startup")
    commonStartup = shell.SpecialFolders("AllUsersStartup")

    ListFolderContents "Current User Startup", userStartup
    ListFolderContents "All Users Startup", commonStartup

    WriteLine ""

End Sub


Sub ListFolderContents(title, folderPath)

    Dim folder, file, subFolder

    WriteLine ""
    WriteLine title & ":"
    WriteLine folderPath

    If Not fso.FolderExists(folderPath) Then
        WriteLine "(Folder not found)"
        Exit Sub
    End If

    On Error Resume Next

    Set folder = fso.GetFolder(folderPath)

    If folder.Files.Count = 0 And folder.SubFolders.Count = 0 Then
        WriteLine "(Empty)"
    End If

    For Each file In folder.Files
        WriteLine "FILE: " & file.Name
    Next

    For Each subFolder In folder.SubFolders
        WriteLine "DIR:  " & subFolder.Name
    Next

    On Error GoTo 0

End Sub


' ============================================================
' Windows proxy configuration
' ============================================================

Sub GetProxySettings()

    Dim enabled, server, autoConfig

    WriteLine "============================================================"
    WriteLine " INTERNET / PROXY SETTINGS"
    WriteLine "============================================================"

    On Error Resume Next

    enabled = shell.RegRead( _
        "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable")

    server = shell.RegRead( _
        "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer")

    autoConfig = shell.RegRead( _
        "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\AutoConfigURL")

    If Err.Number <> 0 Then
        Err.Clear
    End If

    WriteLine "Proxy Enabled: " & SafeValue(enabled)
    WriteLine "Proxy Server:  " & SafeValue(server)
    WriteLine "AutoConfigURL: " & SafeValue(autoConfig)

    WriteLine ""
    WriteLine "Unexpected proxies or PAC URLs deserve investigation."
    WriteLine ""

    On Error GoTo 0

End Sub


' ============================================================
' HOSTS file
' ============================================================

Sub GetHostsFile()

    Dim hostsPath, hostsFile, line

    hostsPath = shell.ExpandEnvironmentStrings( _
        "%WINDIR%\System32\drivers\etc\hosts")

    WriteLine "============================================================"
    WriteLine " WINDOWS HOSTS FILE"
    WriteLine "============================================================"
    WriteLine hostsPath
    WriteLine ""

    On Error Resume Next

    If fso.FileExists(hostsPath) Then

        Set hostsFile = fso.OpenTextFile(hostsPath, 1)

        Do Until hostsFile.AtEndOfStream

            line = hostsFile.ReadLine

            If Trim(line) <> "" Then
                WriteLine line
            End If

        Loop

        hostsFile.Close

    Else

        WriteLine "(HOSTS file not found)"

    End If

    WriteLine ""
    WriteLine "Unexpected website redirects should be investigated."
    WriteLine ""

    On Error GoTo 0

End Sub


' ============================================================
' Running processes
' ============================================================

Sub GetRunningProcesses()

    Dim items, item

    WriteLine "============================================================"
    WriteLine " RUNNING PROCESSES"
    WriteLine "============================================================"

    On Error Resume Next

    Set items = wmi.ExecQuery( _
        "SELECT Name, ProcessId, ExecutablePath, CommandLine " & _
        "FROM Win32_Process")

    For Each item In items

        WriteLine "Process: " & SafeValue(item.Name)
        WriteLine "PID:     " & SafeValue(item.ProcessId)
        WriteLine "Path:    " & SafeValue(item.ExecutablePath)
        WriteLine "Command: " & SafeValue(item.CommandLine)
        WriteLine "------------------------------------------------------------"

    Next

    WriteLine ""

    On Error GoTo 0

End Sub


' ============================================================
' Automatic services
' ============================================================

Sub GetAutoServices()

    Dim items, item

    WriteLine "============================================================"
    WriteLine " AUTOMATIC SERVICES"
    WriteLine "============================================================"

    On Error Resume Next

    Set items = wmi.ExecQuery( _
        "SELECT Name, DisplayName, State, PathName, StartName " & _
        "FROM Win32_Service WHERE StartMode='Auto'")

    For Each item In items

        WriteLine "Service: " & SafeValue(item.Name)
        WriteLine "Name:    " & SafeValue(item.DisplayName)
        WriteLine "State:   " & SafeValue(item.State)
        WriteLine "Account: " & SafeValue(item.StartName)
        WriteLine "Path:    " & SafeValue(item.PathName)
        WriteLine "------------------------------------------------------------"

    Next

    WriteLine ""

    On Error GoTo 0

End Sub


' ============================================================
' Prevent Null values from causing errors
' ============================================================

Function SafeValue(value)

    If IsNull(value) Or IsEmpty(value) Then
        SafeValue = "(none)"
    Else
        SafeValue = CStr(value)
    End If

End Function