1

This is a question for a managed services provider managing thousands of windows 2012-2016 servers. The August 2019 Microsoft patch purports to break many (all?) VB scripts.

I've got the ability to run wmi and/or ansible commands against these machine or send the night shift noc guys at these machines with remote desktop.

Is there a way to know if there are VB Scripts running on any given machine (as part of services from disparate applications). It was suggested to just search for *.vba on the filesystem, but I think that might result in some false positives and false negatives.

Peter Turner
  • 2,178
  • 9
  • 33
  • 45
  • Finding out what scripts exist on the servers and finding out what scripts are running on the servers are two very different things. The only thing I can think is to monitor the processes on each server for an extended period of time, then analyzing the collected data to find what you're looking for... which doesn't sound like a very effective or efficient method. – joeqwerty Aug 19 '19 at 21:05
  • You realize that the patch only prevents Internet Explorer from running VB scripts on web pages? It doesn't affect vbscript running locally. – Harry Johnston Aug 20 '19 at 04:12
  • @HarryJohnston no, didn't realize that (as in, it wasn't communicated to me by our Windows practice), but I'd imagine it does prevent Internet Explorer from running vbscripts locally and Internet Explorer's embedded in applications as COM objects as running vbscripts locally. – Peter Turner Aug 20 '19 at 11:53

2 Answers2

1

I don't know if my old vbscript can help you in your case or not :

So this vbscript will generate an Excel file as report where you will find many useful informations like : All Tasks, No Microsoft tasks, services and startup items.

Option Explicit
Const xlCenter = -4108
Dim objExcel,objWorkbook,objWorksheet,x,objFSO,objCSVFile,arrStr,i
Dim TaskName,CommandLine,Next_Execution,objRange,Date_Debut,Date_Heure
Dim WS,Command_Query_No_Microsoft_Tasks,Log_CSV_Tasks,Task_Status
Dim Last_Date,Log_CSV_ALL_Tasks,Command_Query_ALL_Tasks,strExcelPath

Set WS = CreateObject("Wscript.Shell")
strExcelPath = WS.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\excel.exe\")
If strExcelPath = "" Then
    MsgBox "Unable to export. Excel does not appear to be installed.", vbExclamation, "PC Infos"
End If

Log_CSV_ALL_Tasks = WS.ExpandEnvironmentStrings("%Temp%\Log_CSV_ALL_Tasks.txt")
Log_CSV_Tasks = WS.ExpandEnvironmentStrings("%Temp%\Log_CSV_Tasks.txt")

Command_Query_ALL_Tasks = "CMD /C Schtasks /Query /NH /FO CSV /V>"& Log_CSV_ALL_Tasks &""
WS.Run Command_Query_ALL_Tasks,0,True

Command_Query_No_Microsoft_Tasks = "CMD /C Type "& Log_CSV_ALL_Tasks &" | FindStr /I /V "&_
DblQuote("MICRO")&">"& Log_CSV_Tasks &""
WS.Run Command_Query_No_Microsoft_Tasks,0,True

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
'To Open Excel in Full Screen
objExcel.DisplayFullScreen = True
objExcel.ScreenUpdating = False
objExcel.Workbooks.Add

Call Add_Sheet(1,7,"ALL_Tasks",Log_CSV_ALL_Tasks)
Call Add_Sheet(2,6,"No_Microsoft_Tasks",Log_CSV_Tasks)

Call Startup()
Call No_Microsoft_Services()

Call SaveWorkBook("PC_Infos")
objExcel.ScreenUpdating = True
'Scheduled_Tasks
'--------------------------------------------------
Sub Add_Sheet(Sheet_Index, TabColorIndex, Sheet_Name, CSV_To_Parse)

Set objWorksheet = objExcel.Worksheets(Sheet_Index)
objWorksheet.Tab.ColorIndex = TabColorIndex

With objExcel
    .WorkSheets(Sheet_Index).Name = Sheet_Name
    .WorkSheets(Sheet_Name).Select'
    .Cells(1, 1).Value = "Nom de la tâche"
    .Cells(1, 1).Font.Bold = TRUE
    .Cells(1, 1).Interior.ColorIndex = 43
    .Cells(1, 1).Font.ColorIndex = 2
    .Cells(1, 1).HorizontalAlignment = xlCenter
'--------------------------------------------------
    .Cells(1, 2).Value = "Ligne de Commande"
    .Cells(1, 2).Font.Bold = TRUE
    .Cells(1, 2).Interior.ColorIndex = 43
    .Cells(1, 2).Font.ColorIndex = 2
    .Cells(1, 2).HorizontalAlignment = xlCenter
'--------------------------------------------------
    .Cells(1, 3).Value = "Prochaine exécution"
    .Cells(1, 3).Font.Bold = TRUE
    .Cells(1, 3).Interior.ColorIndex = 43
    .Cells(1, 3).Font.ColorIndex = 2
    .Cells(1, 3).HorizontalAlignment = xlCenter
'--------------------------------------------------
    .Cells(1, 4).Value = "Statut de la tâche planifiée"
    .Cells(1, 4).Font.Bold = TRUE
    .Cells(1, 4).Interior.ColorIndex = 43
    .Cells(1, 4).Font.ColorIndex = 2
    .Cells(1, 4).HorizontalAlignment = xlCenter
'--------------------------------------------------
    .Cells(1, 5).Value = "Date de début"
    .Cells(1, 5).Font.Bold = TRUE
    .Cells(1, 5).Interior.ColorIndex = 43
    .Cells(1, 5).Font.ColorIndex = 2
    .Cells(1, 5).HorizontalAlignment = xlCenter
'--------------------------------------------------
    .Cells(1, 6).Value = "Heure de début"
    .Cells(1, 6).Font.Bold = TRUE
    .Cells(1, 6).Interior.ColorIndex = 43
    .Cells(1, 6).Font.ColorIndex = 2
    .Cells(1, 6).HorizontalAlignment = xlCenter
'--------------------------------------------------
    .Cells(1, 7).Value = "Heure de la dernière exécution"
    .Cells(1, 7).Font.Bold = TRUE
    .Cells(1, 7).Interior.ColorIndex = 43
    .Cells(1, 7).Font.ColorIndex = 2
    .Cells(1, 7).HorizontalAlignment = xlCenter
'--------------------------------------------------
End With

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objCSVFile = objFSO.OpenTextFile(CSV_To_Parse,1)
x = 1
Do while NOT objCSVFile.AtEndOfStream
    arrStr = split(objCSVFile.ReadLine,",")
    TaskName = DeQuote(Replace(arrStr(1),"\",""))
    CommandLine = DeQuote(DeQuote(arrStr(8)))
    Next_Execution = DeQuote(DeQuote(arrStr(2)))
    Task_Status = Replace(DeQuote(DeQuote(arrStr(11))),"‚","é")
    Task_Status = Replace(Task_Status,"ے"," ")
    Task_Status = Replace(Task_Status,""""," ")
    Date_Debut = DeQuote(DeQuote(arrStr(20)))
    Date_Heure = DeQuote(DeQuote(arrStr(19)))
    Date_Heure = Replace(Date_Heure,"?","'")
    Last_Date = DeQuote(DeQuote(arrStr(5)))
    x = x + 1
    With objExcel
        .Cells(x,1) = TaskName
        .Cells(x,2) = CommandLine
        .Cells(x,3) = Next_Execution
        .Cells(x,4) = Task_Status
        .Cells(x,5) = Date_Debut
        .Cells(x,6) = Date_Heure
        .Cells(x,7) = Last_Date
        If Ucase(Next_Execution) = "N/A" Then
            .Cells(x, 1).Font.ColorIndex = 3
            .Cells(x, 2).Font.ColorIndex = 3
            .Cells(x, 3).Font.ColorIndex = 3
            .Cells(x, 4).Font.ColorIndex = 3
            .Cells(x, 5).Font.ColorIndex = 3
            .Cells(x, 6).Font.ColorIndex = 3
            .Cells(x, 7).Font.ColorIndex = 3
        Else
            .Cells(x, 1).Font.ColorIndex = 10
            .Cells(x, 2).Font.ColorIndex = 10
            .Cells(x, 3).Font.ColorIndex = 10
            .Cells(x, 4).Font.ColorIndex = 10
            .Cells(x, 5).Font.ColorIndex = 10
            .Cells(x, 6).Font.ColorIndex = 10
            .Cells(x, 7).Font.ColorIndex = 10
        End If
    End With
Loop
objCSVFile.Close

Set objRange = objWorksheet.UsedRange
objRange.EntireColumn.Autofit()
End Sub
'-------------------------------------------------
Function DeQuote(S)
    If Left(S,1) = """" And Right(S, 1) = """" Then 
        DeQuote = Trim(Mid(S, 2, Len(S) - 2))
    Else 
        DeQuote = Trim(S)
    End If
End Function
'-------------------------------------------------
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'-------------------------------------------------
Sub SaveWorkBook(FileName)
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Network : Set Network = CreateObject("WScript.Network")
Dim Computer : Computer = Network.ComputerName
Dim xlVer,Suffix,Ws
Set Ws = CreateObject("WScript.Shell")
Suffix = computer & "_" & Date & "_" & Time
Suffix = Replace(Suffix,"/","_")
Suffix = Replace(Suffix,":","-")
' Check Excel Version (12.0 = 2007)
xlVer = Split(objExcel.Version,".")(0) 
If xlVer >= "12" Then
    objExcel.ActiveWorkbook.SaveAs fso.GetAbsolutePathName(".") & "\" & FileName & "_" & Suffix & ".xlsx"
    objExcel.DisplayAlerts = True
    Ws.Run DblQuote(fso.GetAbsolutePathName(".") & "\" & FileName & "_" & Suffix & ".xlsx")
' 56 = Excel 97-2003
' Voir la page http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.xlfileformat.aspx
Else
    objExcel.ActiveWorkbook.SaveAs fso.GetAbsolutePathName(".") & "\" & FileName & "_" & Suffix & ".xls",56
    objExcel.DisplayAlerts = True
    Ws.Run DblQuote(fso.GetAbsolutePathName(".") & "\" & FileName & "_" & Suffix & ".xls")
End If
End Sub
'----------------------------------------------------------------------------------
Sub Startup()
    Dim strComputer,objWMIService,colStartupCommands,objWorkSheet,objStartupCommand
    Dim strStartupName,strStartupUser,strStartupLocation,strStartupCommand,intStartRow
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colStartupCommands = objWMIService.ExecQuery ("Select * from Win32_StartupCommand")
    'objExcel.ActiveWorkbook.Sheets.Add
    Set objWorksheet = objExcel.Worksheets(3)
    objWorkSheet.Name = "Startup Details"
    objWorksheet.Tab.ColorIndex = 3
    intStartRow = 2
    objWorkSheet.Cells(1, 1).Interior.ColorIndex = 43
    objWorkSheet.Cells(1, 1).Font.ColorIndex = 2
    objWorkSheet.Cells(1, 2).Interior.ColorIndex = 43
    objWorkSheet.Cells(1, 2).Font.ColorIndex = 2
    objWorkSheet.Cells(1, 3).Interior.ColorIndex = 43
    objWorkSheet.Cells(1, 3).Font.ColorIndex = 2
    objWorkSheet.Cells(1, 4).Interior.ColorIndex = 43
    objWorkSheet.Cells(1, 4).Font.ColorIndex = 2
    objWorkSheet.Cells(1, 1) = "Startup Item"
    objWorkSheet.Cells(1, 2) = "User"
    objWorkSheet.Cells(1, 3) = "Command Line"
    objWorkSheet.Cells(1, 4) = "Startup Location"
    
    For Each objStartupCommand in colStartupCommands
        strStartupName = Trim(objStartupCommand.Name)
        strStartupUser = objStartupCommand.User
        strStartupLocation = objStartupCommand.Location
        strStartupCommand = objStartupCommand.Command
        objWorkSheet.Cells(intStartRow, 1) = strStartupName
        objWorkSheet.Cells(intStartRow, 2) = strStartupUser
        objWorkSheet.Cells(intStartRow, 3) = strStartupLocation
        objWorkSheet.Cells(intStartRow, 4) = strStartupCommand
        intStartRow = intStartRow + 1
    Next
    objWorkSheet.Columns("A:A").EntireColumn.AutoFit
    objWorkSheet.Columns("B:B").EntireColumn.AutoFit
    objWorkSheet.Columns("C:C").EntireColumn.AutoFit
    objWorkSheet.Columns("D:D").EntireColumn.AutoFit
End Sub
'----------------------------------------------------------------------------------
Sub No_Microsoft_Services()
Dim strComputer,objWMIService
Dim State,colServices,x,objService,objWorksheet,objWorkbook
Set objWorksheet = objExcel.ActiveWorkbook.Sheets.Add
objWorksheet.Name = "No-Microsoft_Services"
objExcel.WorkSheets("No-Microsoft_Services").select
objWorksheet.Tab.ColorIndex = 8

' Format the cell A1 and add the text: Service Name
objWorkSheet.Cells(1, 1).Value = "Service Name"
objWorkSheet.Cells(1, 1).Font.Bold = TRUE
objWorkSheet.Cells(1, 1).Interior.ColorIndex = 43
objWorkSheet.Cells(1, 1).Font.ColorIndex = 2
' Format the cell A2 and add the text: Display Name
objWorkSheet.Cells(1, 2).Value = "Display Name"
objWorkSheet.Cells(1, 2).Font.Bold = TRUE
objWorkSheet.Cells(1, 2).Interior.ColorIndex = 43
objWorkSheet.Cells(1, 2).Font.ColorIndex = 2
'*************************************************
' Format the cell A3 and add the text: State
objWorkSheet.Cells(1, 3).Value = "State"
objWorkSheet.Cells(1, 3).Font.Bold = TRUE
objWorkSheet.Cells(1, 3).Interior.ColorIndex = 43
objWorkSheet.Cells(1, 3).Font.ColorIndex = 2
'*************************************************
' Format the cell A4 and add the text: Executable Path
objWorkSheet.Cells(1, 4).Value = "Executable Path"
objWorkSheet.Cells(1, 4).Font.Bold = TRUE
objWorkSheet.Cells(1, 4).Interior.ColorIndex = 43
objWorkSheet.Cells(1, 4).Font.ColorIndex = 2
'*************************************************
' Format the cell A5 and add the text: Description
objWorkSheet.Cells(1, 5).Value = "Description"
objWorkSheet.Cells(1, 5).Font.Bold = TRUE
objWorkSheet.Cells(1, 5).Interior.ColorIndex = 43
objWorkSheet.Cells(1, 5).Font.ColorIndex = 2

' Find the Non-Microsoft Windows services on this computer
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServices = objWMIService.ExecQuery("Select * From Win32_Service where Not PathName like '%Micro%' AND Not PathName like '%Windows%'")
' Write each service to Excel, starting in A2
x = 1
For Each objService in colServices
    x = x + 1
    objWorkSheet.Cells(x, 1) = objService.Name
    objWorkSheet.Cells(x, 2) = objService.DisplayName
    objWorkSheet.Cells(x, 3) = objService.State
    objWorkSheet.Cells(x, 4) = objService.PathName
    objWorkSheet.Cells(x, 5) = objService.Description
    State = objService.Started
    If State Then 
        objWorkSheet.Cells(x, 1).Font.ColorIndex = 10
        objWorkSheet.Cells(x, 2).Font.ColorIndex = 10
        objWorkSheet.Cells(x, 3).Font.ColorIndex = 10
        objWorkSheet.Cells(x, 4).Font.ColorIndex = 10
        objWorkSheet.Cells(x, 5).Font.ColorIndex = 10
    ELSE
        objWorkSheet.Cells(x, 1).Font.ColorIndex = 3
        objWorkSheet.Cells(x, 2).Font.ColorIndex = 3
        objWorkSheet.Cells(x, 3).Font.ColorIndex = 3
        objWorkSheet.Cells(x, 4).Font.ColorIndex = 3
        objWorkSheet.Cells(x, 5).Font.ColorIndex = 3
    end if
Next

objWorkSheet.Columns("A:A").EntireColumn.AutoFit
objWorkSheet.Columns("B:B").EntireColumn.AutoFit
objWorkSheet.Columns("C:C").EntireColumn.AutoFit
objWorkSheet.Columns("D:D").EntireColumn.AutoFit
objWorkSheet.Columns("E:E").EntireColumn.AutoFit
End Sub
'----------------------------------------------------------------------------------
Hackoo
  • 115
  • 5
1

I'd search for scheduled tasks that run scripts, and if you have AV or FSRM on the servers, I'd set it up to log when the scripting host runs, or a vbs/wsf file is opened.

Chris
  • 955
  • 7
  • 17