Option Explicit

' SPECIAL PARTY INVITATION ScreenConnect RAT remediation.
' Audit only by default. Run elevated with /apply to remediate.

Const HKEY_LOCAL_MACHINE = &H80000002
Const ForReading = 1

Dim shell, fso, applyMode, noScan, baseDir, logDir, quarantineDir, backupDir
Dim logFile, stamp, serviceName, instanceId, relayHost, relayIp, relayPort
Dim productCode, credClsid, auditScriptPath, preAuditOk, postAuditOk, exportedKeys
Dim knownVbsHash, knownMsiHash, knownZipHash, knownPsHash

Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

' Every line is written to the console as well as the log. Under wscript.exe
' that would be one modal dialog per line, so the interactive host is refused
' with a single message instead of several hundred.
If LCase(fso.GetFileName(WScript.FullName)) <> "cscript.exe" Then
    MsgBox "Run this remediation from an elevated Command Prompt:" & vbCrLf & vbCrLf & _
        "cscript //nologo " & Chr(34) & WScript.ScriptFullName & Chr(34), _
        vbExclamation, "AlomSec ScreenConnect remediation"
    WScript.Quit 4
End If

applyMode = WScript.Arguments.Named.Exists("apply")
noScan = WScript.Arguments.Named.Exists("no-scan")
stamp = TimeStamp()
preAuditOk = False
postAuditOk = False
Set exportedKeys = CreateObject("Scripting.Dictionary")

serviceName = "ScreenConnect Client (fa12121053c2d7fe)"
instanceId = "fa12121053c2d7fe"
relayHost = "relay.rupilure.top"
relayIp = "74.120.121.48"
relayPort = "8041"
productCode = "{1512A1A9-AF5F-B443-AFD0-CB33309C9829}"
credClsid = "{6FF59A85-BC37-4CD4-232E-D6E8F83B1EAE}"
auditScriptPath = fso.GetParentFolderName(WScript.ScriptFullName) & "\full_audit.ps1"

knownVbsHash = "1786e22352f7936c9d28b1f94e3e84994191f88d4cee78abef11c0ff9b4cc4b9"
knownMsiHash = "220aec6ce4e45fbaf2f807bab0478680c342f8eaf99bd95de726eae730d6926b"
knownZipHash = "e75eca7a5b879736fbd4413e59bf2ad311b526d29bb0200871123d1cbc2e8655"
knownPsHash = "70540e6547c48bcd46c6f2a8d4e200d8b3b30e638cf5c338ff70c3d85cf9b520"

baseDir = shell.ExpandEnvironmentStrings("%ProgramData%") & "\Argus-Omni-ScreenConnect-Remediation"
logDir = baseDir & "\Logs"
quarantineDir = baseDir & "\Quarantine\" & stamp
backupDir = baseDir & "\Registry-Backups\" & stamp
EnsureFolder logDir
Set logFile = fso.OpenTextFile(logDir & "\remediation-" & stamp & ".log", 8, True)

Log "Mode: " & IIf(applyMode, "APPLY", "AUDIT ONLY")
Log "Target instance: " & serviceName
Log "Target relay: " & relayHost & " (" & relayIp & ") port " & relayPort

If applyMode And Not IsAdministrator() Then
    Log "ERROR: /apply requires an elevated Administrator command prompt."
    WScript.Echo "Remediation was not started. Re-run cscript as Administrator."
    logFile.Close
    WScript.Quit 5
End If

' The pre-remediation snapshot is the only record of the machine as it was
' found. Changing anything without it destroys evidence, so a missing audit
' companion stops /apply before the first change rather than after it.
If applyMode And Not fso.FileExists(auditScriptPath) Then
    Log "ERROR: full_audit.ps1 is missing from " & fso.GetParentFolderName(WScript.ScriptFullName)
    Log "No change was made. Both files must sit in the same folder."
    WScript.Echo "Remediation was not started. Keep full_audit.ps1 beside this script."
    logFile.Close
    WScript.Quit 6
End If

' /apply requires a COMPLETE snapshot, so exit 2 (finished with recorded
' errors) is refused here even though audit-only accepts it.
preAuditOk = RunFullAudit("pre-remediation", applyMode)

' The pre-remediation snapshot is the record that justifies every later change.
' Without it, /apply would be destroying evidence it never captured, so it stops
' here rather than proceeding on a snapshot that does not exist.
If applyMode And Not preAuditOk Then
    Log "ERROR: the pre-remediation audit did not complete cleanly. Nothing was changed."
    Log "Re-run the audit, resolve the cause, then run /apply again."
    WScript.Echo "Remediation was not started: the pre-remediation audit failed. Log: " & logDir
    logFile.Close
    WScript.Quit 7
End If

' Reads sockets and the resolver cache. Nothing here changes the machine, in
' either mode, so it runs before the evidence gate.
AuditNetwork

' Everything that can change this computer is behind this block. Registry
' evidence is captured and checked FIRST, before the restore point, before any
' process is terminated and before the service is stopped: killing the RAT and
' stopping its service are remediation actions, not preparation, and doing them
' ahead of the gate meant a backup failure aborted a machine that had already
' been altered.
If applyMode Then
    EnsureFolder quarantineDir
    EnsureFolder backupDir
    BackupRegistry
    ' The MSI uninstall removes the Uninstall key and the installed files, and
    ' sc delete removes the service key. Both destroy exactly the evidence
    ' BackupRegistry was supposed to capture, and both used to run before any
    ' export failure was consulted. One aggregate gate now covers every
    ' destructive step that follows, not just the individual reg deletes.
    If Not BackupsAreComplete() Then
        Log "ERROR: a targeted registry key exists but could not be exported."
        Log "No process was terminated, no service was stopped, and no restore point," & _
            " uninstall, service removal, registry change, LSA edit, quarantine," & _
            " indicator cleanup, or scan was performed."
        Log "The only things written were this log, the pre-remediation audit snapshot," & _
            " and the registry exports that did succeed."
        Log "Fix the export failure (usually elevation or disk space) and run /apply again."
        WScript.Echo "Remediation stopped: registry evidence could not be preserved. Log: " & logDir
        logFile.Close
        WScript.Quit 8
    End If
    CreateRestorePoint
End If

' Audit mode only reports what it finds here; the terminate and stop calls
' inside are guarded by applyMode, which the gate above has already cleared.
StopTargetProcesses
StopTargetService

If applyMode Then
    UninstallKnownProduct
    DeleteTargetService
    RemoveKnownRegistryPersistence
    RemoveLsaAuthenticationPackage
End If

InspectTargetFolders
InspectKnownDroppedFiles

If applyMode Then
    ' For /apply the post-remediation audit is the verification that the
    ' cleanup worked, so a partial one is not a pass: exit 2 here means some
    ' check or removal recorded an error and a human has to look.
    postAuditOk = RunFullAudit("post-remediation", True)
    If Not noScan Then StartDefenderScan
End If

If applyMode And postAuditOk Then
    Log "Completed. Reboot this computer now."
    Log "After reboot, run Microsoft Defender Offline scan and rotate passwords from a known-clean device."
ElseIf applyMode Then
    Log "Remediation actions finished, but the post-remediation verification did NOT complete cleanly."
    Log "Do NOT treat this computer as clean. Read SUMMARY.txt and audit-errors.csv in the"
    Log "post-remediation folder under " & baseDir & "\Audits before deciding what to do next."
    Log "Reboot, run Microsoft Defender Offline, rotate passwords from a known-clean device,"
    Log "and rebuild this computer if its integrity cannot be established."
ElseIf preAuditOk Then
    Log "Audit complete. Nothing on this computer was changed."
Else
    Log "Audit INCOMPLETE. Nothing on this computer was changed, and the findings below cover only what was collected."
End If
logFile.Close

' The console line is what the operator actually reads. It used to say
' "Remediation completed" whenever /apply ran, including the runs that failed
' verification and exited 3.
If applyMode And postAuditOk Then
    WScript.Echo "Remediation completed. Reboot now. Log: " & logDir
ElseIf applyMode Then
    WScript.Echo "Remediation actions finished, but post-remediation verification FAILED."
    WScript.Echo "Do NOT treat this computer as clean."
    WScript.Echo "Read SUMMARY.txt and audit-errors.csv under " & baseDir & "\Audits"
    WScript.Echo "Log: " & logDir
ElseIf preAuditOk Then
    WScript.Echo "Audit completed. No changes were made. Log: " & logDir
    WScript.Echo "To remediate, run elevated: cscript //nologo """ & WScript.ScriptFullName & """ /apply"
Else
    WScript.Echo "Audit did not complete. No changes were made. Log: " & logDir
End If

' A caller that scripts this needs the exit code to tell the truth about
' whether a usable snapshot exists.
If Not preAuditOk Then WScript.Quit 3
If applyMode And Not postAuditOk Then WScript.Quit 3

Function IIf(condition, trueValue, falseValue)
    If condition Then
        IIf = trueValue
    Else
        IIf = falseValue
    End If
End Function

Function TimeStamp()
    Dim d
    d = Now
    TimeStamp = Year(d) & Right("0" & Month(d), 2) & Right("0" & Day(d), 2) & "-" & _
        Right("0" & Hour(d), 2) & Right("0" & Minute(d), 2) & Right("0" & Second(d), 2)
End Function

Sub EnsureFolder(path)
    Dim parent
    If fso.FolderExists(path) Then Exit Sub
    parent = fso.GetParentFolderName(path)
    If Len(parent) > 0 And Not fso.FolderExists(parent) Then EnsureFolder parent
    fso.CreateFolder path
End Sub

Sub Log(message)
    Dim line
    line = Now & "  " & message
    logFile.WriteLine line
    WScript.Echo line
End Sub

Function Quote(value)
    Quote = Chr(34) & value & Chr(34)
End Function

Function SafeText(value)
    If IsNull(value) Or IsEmpty(value) Then
        SafeText = ""
    Else
        SafeText = CStr(value)
    End If
End Function

Function IsAdministrator()
    Dim rc
    rc = shell.Run("cmd.exe /d /c net session >nul 2>&1", 0, True)
    IsAdministrator = (rc = 0)
End Function

Function Run(command, waitForExit)
    On Error Resume Next
    Dim rc
    rc = shell.Run(command, 0, waitForExit)
    If Err.Number <> 0 Then
        Log "Command error " & Err.Number & ": " & command
        Err.Clear
        Run = -1
    Else
        Run = rc
    End If
    On Error GoTo 0
End Function

' full_audit.ps1 exits 0 when it finished clean, 2 when it finished but recorded
' its own errors, and anything else when it did not finish.
'
' requireCleanExit draws the line between the two callers. Reporting is allowed
' to work from a partial snapshot -- a reader can see what was collected and
' what failed. Remediation is not: the pre-remediation snapshot is the evidence
' baseline that justifies destroying anything, so /apply demands exit 0.
Function RunFullAudit(phase, requireCleanExit)
    Dim auditDir, command, rc
    RunFullAudit = False
    auditDir = baseDir & "\Audits\" & stamp & "-" & phase
    If Not fso.FileExists(auditScriptPath) Then
        Log "ERROR: Full-audit companion is missing: " & auditScriptPath
        Exit Function
    End If
    EnsureFolder auditDir
    command = "powershell.exe -NoLogo -NoProfile -NonInteractive -ExecutionPolicy Bypass -File " & _
        Quote(auditScriptPath) & " -OutputDir " & Quote(auditDir) & " -Phase " & Quote(phase)
    ' VBScript's And evaluates both sides, so the mode flag is tested on its own
    ' line: naming an undeclared variable here aborted the whole run under
    ' Option Explicit before either audit could start.
    If LCase(phase) = "post-remediation" Then
        If applyMode Then command = command & " -CleanupKnownIndicators"
    End If
    Log "Starting full system audit: " & phase
    rc = Run(command, True)
    Log "Full system audit exit code=" & rc & " output=" & auditDir
    If rc = 0 Then
        RunFullAudit = True
    ElseIf rc = 2 And Not requireCleanExit Then
        Log "WARNING: the " & phase & " audit finished but recorded errors (exit 2)." & _
            " The snapshot is partial; see audit-errors.csv."
        RunFullAudit = True
    ElseIf rc = 2 Then
        Log "ERROR: the " & phase & " audit recorded errors (exit 2). /apply requires a" & _
            " complete snapshot, so this is not accepted as an evidence baseline."
    Else
        Log "ERROR: the " & phase & " audit did not complete (exit " & rc & ")." & _
            " Treat this snapshot as incomplete."
    End If
End Function

' Fail-closed aggregate: every targeted key that exists must have been exported
' before anything destructive runs. One unexportable key stops the whole apply.
Function BackupsAreComplete()
    Dim key
    BackupsAreComplete = True
    For Each key In exportedKeys.Keys
        If Not exportedKeys.Item(key) Then
            Log "Blocking remediation, this key exists but was not exported: " & key
            BackupsAreComplete = False
        End If
    Next
End Function

' Output is collected through a temporary file rather than an Exec pipe. A pipe
' holds only a few kilobytes, and this script captures netstat and the whole
' resolver cache: on a busy host the child blocks writing while the script sits
' in its wait loop, and the tool hangs on exactly the machines it is for.
Function Capture(command)
    On Error Resume Next
    Dim tempFile, reader, text
    text = ""
    tempFile = fso.BuildPath(fso.GetSpecialFolder(2), fso.GetTempName())
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        Capture = ""
        Exit Function
    End If
    Run "cmd.exe /d /c " & command & " > " & Quote(tempFile) & " 2>&1", True
    If fso.FileExists(tempFile) Then
        Set reader = fso.OpenTextFile(tempFile, ForReading, False)
        If Err.Number = 0 Then
            If Not reader.AtEndOfStream Then text = reader.ReadAll
            reader.Close
        End If
        Err.Clear
        fso.DeleteFile tempFile, True
    End If
    Err.Clear
    On Error GoTo 0
    Capture = text
End Function

Function Sha256(path)
    Dim output, re, matches
    Sha256 = ""
    If Not fso.FileExists(path) Then Exit Function
    output = Capture("certutil.exe -hashfile " & Quote(path) & " SHA256")
    Set re = New RegExp
    re.Pattern = "\b[0-9A-Fa-f]{64}\b"
    re.Global = False
    Set matches = re.Execute(output)
    If matches.Count > 0 Then Sha256 = LCase(matches(0).Value)
End Function

Sub CreateRestorePoint()
    Dim cmd, rc
    cmd = "powershell.exe -NoProfile -NonInteractive -Command " & Quote( _
        "$ErrorActionPreference='Stop'; Checkpoint-Computer -Description 'Before AlomSec ScreenConnect remediation' -RestorePointType MODIFY_SETTINGS")
    rc = Run(cmd, True)
    If rc = 0 Then
        Log "Created a System Restore point."
    Else
        Log "System Restore point was unavailable; continuing with registry exports and quarantine."
    End If
End Sub

' Filtering happens here rather than in a piped findstr. Exec starts a process
' directly, with no outer shell to consume the caret, so "^|" reached cmd as an
' escaped literal pipe: netstat was handed "|" as an argument, printed its usage
' text, and that usage text was long enough to be reported as a live connection.
Function MatchingLines(text, needle)
    Dim lines, line, hits, wanted
    hits = ""
    wanted = LCase(needle)
    lines = Split(Replace(text, vbCrLf, vbLf), vbLf)
    For Each line In lines
        If Len(Trim(line)) > 0 And InStr(LCase(line), wanted) > 0 Then
            If Len(hits) > 0 Then hits = hits & " | "
            hits = hits & Trim(line)
        End If
    Next
    MatchingLines = hits
End Function

Sub AuditNetwork()
    Dim sockets, toRelay, onPort, cached
    ' netstat -ano prints addresses, never names, so the relay is matched by
    ' address. The relay name is looked for in the resolver cache instead of
    ' being resolved: an outbound lookup would reach the campaign's own DNS
    ' servers and announce that this host is being cleaned.
    sockets = Capture("netstat.exe -ano")
    toRelay = MatchingLines(sockets, relayIp)
    If Len(toRelay) > 0 Then
        Log "ACTIVE TARGET CONNECTION: " & toRelay
    Else
        Log "No socket to the known relay address " & relayIp & " was visible."
    End If

    onPort = MatchingLines(sockets, ":" & relayPort & " ")
    If Len(onPort) > 0 Then
        Log "REVIEW: socket on campaign relay port " & relayPort & ": " & onPort
    End If

    cached = MatchingLines(Capture("ipconfig.exe /displaydns"), relayHost)
    If Len(cached) > 0 Then
        Log "RELAY NAME IN DNS CACHE: " & cached
    End If
End Sub

Function HasTargetMarker(value)
    Dim text
    text = LCase(SafeText(value))
    HasTargetMarker = (InStr(text, LCase(instanceId)) > 0 Or _
        InStr(text, LCase(relayHost)) > 0 Or _
        InStr(text, relayIp) > 0 Or _
        InStr(text, "\programdata\windows security\screenconnect") > 0)
End Function

Sub StopTargetProcesses()
    On Error Resume Next
    Dim wmi, processes, process, marker
    Set wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set processes = wmi.ExecQuery("SELECT * FROM Win32_Process")
    For Each process In processes
        marker = SafeText(process.ExecutablePath) & " " & SafeText(process.CommandLine)
        If HasTargetMarker(marker) Then
            Log "Target process found: PID=" & process.ProcessId & " " & marker
            If applyMode Then
                process.Terminate 1
                Log "Terminated target process PID=" & process.ProcessId
            End If
        End If
    Next
    If Err.Number <> 0 Then
        Log "Process audit warning: " & Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Sub StopTargetService()
    On Error Resume Next
    Dim wmi, services, service, found
    found = False
    Set wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set services = wmi.ExecQuery("SELECT * FROM Win32_Service")
    For Each service In services
        If LCase(CStr(service.Name)) = LCase(serviceName) Then
            found = True
            Log "Target service found: state=" & service.State & " path=" & service.PathName
            If applyMode Then
                service.StopService
                WScript.Sleep 1500
                Log "Stopped the target service before MSI removal."
            End If
        End If
    Next
    If Not found Then Log "Target service was not registered."
    If Err.Number <> 0 Then
        Log "Service audit warning: " & Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Sub DeleteTargetService()
    Dim rc
    rc = Run("sc.exe delete " & Quote(serviceName), True)
    Log "Post-uninstall service delete exit code: " & rc
End Sub

Function RegistryKeyExists(keyPath)
    RegistryKeyExists = (Run("reg.exe query " & Quote(keyPath), True) = 0)
End Function

' Records, per key, whether removal is allowed. An absent key is allowed because
' there is nothing to lose; a key that exists but could not be exported is NOT,
' because deleting it would destroy the only copy of that evidence.
Sub BackupOneRegistryKey(keyPath, fileName)
    Dim rc, exportPath
    exportPath = backupDir & "\" & fileName & ".reg"
    If Not RegistryKeyExists(keyPath) Then
        Log "Registry key absent, nothing to export or remove: " & keyPath
        exportedKeys.Item(LCase(keyPath)) = True
        Exit Sub
    End If
    rc = Run("reg.exe export " & Quote(keyPath) & " " & Quote(exportPath) & " /y", True)
    If rc = 0 And fso.FileExists(exportPath) Then
        Log "Backed up registry key: " & keyPath
        exportedKeys.Item(LCase(keyPath)) = True
    Else
        Log "EXPORT FAILED (exit " & rc & ") for " & keyPath & _
            ". It will NOT be removed, so the evidence is not destroyed."
        exportedKeys.Item(LCase(keyPath)) = False
    End If
End Sub

Function TargetRegistryKeys()
    TargetRegistryKeys = Array( _
        Array("HKLM\SYSTEM\CurrentControlSet\Services\" & serviceName, "service"), _
        Array("HKLM\SYSTEM\CurrentControlSet\Control\SafeBoot\Network\" & serviceName, "safeboot-network"), _
        Array("HKLM\SOFTWARE\Classes\sc-" & instanceId, "url-scheme"), _
        Array("HKLM\SOFTWARE\Classes\CLSID\" & credClsid, "credential-provider-clsid"), _
        Array("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\Credential Providers\" & credClsid, "credential-provider"), _
        Array("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & productCode, "uninstall"), _
        Array("HKLM\SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\" & productCode, "uninstall-wow6432node"))
End Function

Sub BackupRegistry()
    Dim entry
    ' Every key that RemoveKnownRegistryPersistence can delete is exported here.
    For Each entry In TargetRegistryKeys()
        BackupOneRegistryKey entry(0), entry(1)
    Next
    ' Not deleted, only edited, but the same guarantee applies before the edit.
    BackupOneRegistryKey "HKLM\SYSTEM\CurrentControlSet\Control\Lsa", "lsa"
End Sub

Sub UninstallKnownProduct()
    Dim rc
    Log "Attempting Windows Installer removal for " & productCode
    rc = Run("msiexec.exe /x " & productCode & " /qn /norestart", True)
    Log "Windows Installer removal exit code: " & rc
End Sub

Sub DeleteRegistryKey(keyPath)
    Dim rc
    If Not exportedKeys.Exists(LCase(keyPath)) Then
        Log "SKIPPED removal, no export was attempted for: " & keyPath
        Exit Sub
    End If
    If Not exportedKeys.Item(LCase(keyPath)) Then
        Log "SKIPPED removal, the export of this key failed: " & keyPath
        Exit Sub
    End If
    rc = Run("reg.exe delete " & Quote(keyPath) & " /f", True)
    If rc = 0 Then Log "Removed registry key: " & keyPath
End Sub

Sub RemoveKnownRegistryPersistence()
    Dim entry
    For Each entry In TargetRegistryKeys()
        DeleteRegistryKey entry(0)
    Next
End Sub

Sub RemoveLsaAuthenticationPackage()
    On Error Resume Next
    Dim reg, values, kept(), count, i, value, removed, rc, lsaKey
    lsaKey = LCase("HKLM\SYSTEM\CurrentControlSet\Control\Lsa")
    If Not exportedKeys.Exists(lsaKey) Then
        Log "SKIPPED LSA cleanup, no export was attempted for the Lsa key."
        Exit Sub
    End If
    If Not exportedKeys.Item(lsaKey) Then
        Log "SKIPPED LSA cleanup, the Lsa key could not be exported first."
        Exit Sub
    End If
    Set reg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    rc = reg.GetMultiStringValue(HKEY_LOCAL_MACHINE, _
        "SYSTEM\CurrentControlSet\Control\Lsa", "Authentication Packages", values)
    If rc <> 0 Or Not IsArray(values) Then
        Log "LSA Authentication Packages could not be read; registry backup was retained."
        Exit Sub
    End If
    ReDim kept(UBound(values))
    count = 0
    removed = False
    For i = LBound(values) To UBound(values)
        value = CStr(values(i))
        If InStr(LCase(value), "screenconnect.windowsauthenticationpackage.dll") > 0 Then
            removed = True
            Log "Removing target LSA authentication package entry: " & value
        Else
            kept(count) = value
            count = count + 1
        End If
    Next
    If removed And count > 0 Then
        ReDim Preserve kept(count - 1)
        rc = reg.SetMultiStringValue(HKEY_LOCAL_MACHINE, _
            "SYSTEM\CurrentControlSet\Control\Lsa", "Authentication Packages", kept)
        Log "LSA Authentication Packages update exit code: " & rc
    ElseIf removed Then
        ' Clearing the value outright can stop every interactive logon, which is
        ' a worse outcome than the package staying loaded until a human looks.
        Log "WARNING: the target entry was the only Authentication Package. The value was" & _
            " left in place to keep logon working. Restore " & backupDir & "\lsa.reg" & _
            " after adding msv1_0 back by hand."
    Else
        Log "Target LSA authentication package entry was not present."
    End If
    If Err.Number <> 0 Then
        Log "LSA cleanup warning: " & Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Function FileHasMarker(path)
    On Error Resume Next
    Dim reader, text
    FileHasMarker = False
    Set reader = fso.OpenTextFile(path, ForReading, False)
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Function
    End If
    text = reader.ReadAll
    reader.Close
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Function
    End If
    On Error GoTo 0
    FileHasMarker = HasTargetMarker(text)
End Function

' True only when this folder carries an identifier from THIS incident. The
' presence of ScreenConnect binaries is deliberately not enough: an approved
' deployment of the same product must never be quarantined by a campaign tool.
Function FolderHasMarkerEvidence(folder, depth)
    On Error Resume Next
    Dim file, child, extension
    FolderHasMarkerEvidence = False
    If HasTargetMarker(folder.Path) Then
        FolderHasMarkerEvidence = True
        On Error GoTo 0
        Exit Function
    End If
    For Each file In folder.Files
        If HasTargetMarker(file.Path) Then
            FolderHasMarkerEvidence = True
            On Error GoTo 0
            Exit Function
        End If
        extension = LCase(fso.GetExtensionName(file.Name))
        If file.Size <= 1048576 And ( _
                extension = "config" Or extension = "xml" Or extension = "ini" Or _
                extension = "url" Or extension = "txt" Or extension = "json") Then
            If FileHasMarker(file.Path) Then
                FolderHasMarkerEvidence = True
                On Error GoTo 0
                Exit Function
            End If
        End If
    Next
    If depth < 3 Then
        For Each child In folder.SubFolders
            If FolderHasMarkerEvidence(child, depth + 1) Then
                FolderHasMarkerEvidence = True
                On Error GoTo 0
                Exit Function
            End If
        Next
    End If
    Err.Clear
    On Error GoTo 0
End Function

Function FolderLooksTargeted(path)
    FolderLooksTargeted = False
    If Not fso.FolderExists(path) Then Exit Function
    FolderLooksTargeted = FolderHasMarkerEvidence(fso.GetFolder(path), 0)
End Function

Function FolderHasScreenConnectBinaries(path)
    FolderHasScreenConnectBinaries = _
        fso.FileExists(path & "\ScreenConnect.ClientService.exe") Or _
        fso.FileExists(path & "\ScreenConnect.WindowsClient.exe")
End Function

' Two quarantined items can share a leaf name -- the same instance folder under
' both Program Files trees, or one dropper per user profile. Without a unique
' destination the second move fails and that evidence is left in place.
Function UniqueQuarantinePath(baseName)
    Dim candidate, index
    candidate = quarantineDir & "\" & baseName
    index = 1
    Do While fso.FileExists(candidate) Or fso.FolderExists(candidate)
        candidate = quarantineDir & "\" & baseName & "-" & index
        index = index + 1
    Loop
    UniqueQuarantinePath = candidate
End Function

Sub QuarantineFolder(path)
    On Error Resume Next
    Dim destination, rc
    If Not fso.FolderExists(path) Then Exit Sub
    destination = UniqueQuarantinePath("folder-" & Replace(Replace(fso.GetFileName(path), " ", "_"), ":", "_"))
    rc = Run("attrib.exe -h -s " & Quote(path) & " /s /d", True)
    rc = Run("icacls.exe " & Quote(path) & " /inheritance:e /grant:r *S-1-5-18:(OI)(CI)F *S-1-5-32-544:(OI)(CI)F /t /c", True)
    fso.MoveFolder path, destination
    If Err.Number = 0 Then
        Log "Quarantined target folder: " & path & " -> " & destination
    Else
        Log "Could not quarantine folder " & path & ": " & Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Sub InspectTargetFolders()
    Dim programFiles, programFiles86, path, hiddenPath
    programFiles = shell.ExpandEnvironmentStrings("%ProgramFiles%")
    programFiles86 = shell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
    path = programFiles & "\" & serviceName
    If fso.FolderExists(path) Then
        Log "Target installation folder found: " & path
        If applyMode Then QuarantineFolder path
    End If
    If programFiles86 <> "%ProgramFiles(x86)%" Then
        path = programFiles86 & "\" & serviceName
        If fso.FolderExists(path) Then
            Log "Target installation folder found: " & path
            If applyMode Then QuarantineFolder path
        End If
    End If
    hiddenPath = shell.ExpandEnvironmentStrings("%ProgramData%") & "\Windows Security"
    If fso.FolderExists(hiddenPath) Then
        If FolderLooksTargeted(hiddenPath) Then
            Log "Target ScreenConnect files found in disguised folder: " & hiddenPath
            If applyMode Then QuarantineFolder hiddenPath
        ElseIf FolderHasScreenConnectBinaries(hiddenPath) Then
            Log "REVIEW: remote-access binaries in " & hiddenPath & " carry no marker from this" & _
                " incident. Nothing was changed. Confirm ownership before removing them by hand."
        Else
            Log "A Windows Security folder exists but lacks target markers; left untouched: " & hiddenPath
        End If
    End If
End Sub

Sub InspectKnownFile(path, expectedHash, label)
    Dim actual
    If Not fso.FileExists(path) Then Exit Sub
    actual = Sha256(path)
    If LCase(actual) = LCase(expectedHash) Then
        Log "Known malicious " & label & " found: " & path & " sha256=" & actual
        If applyMode Then QuarantineFile path, label
    Else
        Log "File name matched but hash did not; left untouched: " & path & " sha256=" & actual
    End If
End Sub

Sub QuarantineFile(path, label)
    On Error Resume Next
    Dim destination
    destination = UniqueQuarantinePath(label & "-" & fso.GetFileName(path))
    fso.MoveFile path, destination
    If Err.Number = 0 Then
        Log "Quarantined file: " & path & " -> " & destination
    Else
        Log "Could not quarantine file " & path & ": " & Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Sub InspectProfileDrops(profilePath)
    Dim locations, location
    InspectKnownFile profilePath & "\AppData\Local\Microsoft\sc.msi", knownMsiHash, "malicious-msi"
    InspectKnownFile profilePath & "\Documents\7BfFmUE8PL.ps1", knownPsHash, "powershell-stage"
    locations = Array(profilePath & "\Downloads", profilePath & "\Desktop", profilePath & "\Documents")
    For Each location In locations
        InspectKnownFile location & "\invite_174204.vbs", knownVbsHash, "vbs-loader"
        InspectKnownFile location & "\invite_174204.zip", knownZipHash, "delivery-zip"
    Next
End Sub

' The invitation lands in the profile of whoever opened the mail, and /apply is
' run from an elevated prompt that is often a different account. Checking only
' %UserProfile% left the original dropper on disk on exactly the machines this
' tool exists for, so every local profile is checked.
Sub InspectKnownDroppedFiles()
    Dim userProfile, usersRoot, folder, seen
    Set seen = CreateObject("Scripting.Dictionary")
    userProfile = shell.ExpandEnvironmentStrings("%UserProfile%")
    seen.Add LCase(userProfile), True
    InspectProfileDrops userProfile

    usersRoot = fso.GetParentFolderName(userProfile)
    If Len(usersRoot) = 0 Or Not fso.FolderExists(usersRoot) Then
        usersRoot = shell.ExpandEnvironmentStrings("%SystemDrive%") & "\Users"
    End If
    If Not fso.FolderExists(usersRoot) Then Exit Sub

    On Error Resume Next
    For Each folder In fso.GetFolder(usersRoot).SubFolders
        If Not seen.Exists(LCase(folder.Path)) Then
            seen.Add LCase(folder.Path), True
            InspectProfileDrops folder.Path
        End If
    Next
    If Err.Number <> 0 Then
        Log "Profile enumeration warning: " & Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Sub StartDefenderScan()
    Dim cmd, rc
    cmd = "powershell.exe -NoProfile -NonInteractive -Command " & Quote( _
        "Start-MpScan -ScanType QuickScan")
    ' Not waited on: a quick scan outlives this script. Run returns 0 for any
    ' successful launch when it does not wait, so only a launch failure is
    ' reportable here -- the scan result itself is read in Defender.
    rc = Run(cmd, False)
    If rc = -1 Then
        Log "Microsoft Defender scan could not be started."
    Else
        Log "Requested a Microsoft Defender Quick Scan in the background."
    End If
End Sub