原创 蓝胖子之家
On Error Resume Next
Dim Fso, WshShell
Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
Set WshShell = CreateObject("wScRipT.SHelL")
Call Main
Sub Main()
On Error Resume Next
Dim Args, VirusLoad, VirusAss
Set Args = WScript.Arguments
VirusLoad = GetMainVirus(1)
VirusAss = GetMainVirus(0)
Call VirusAlert
Call MonitorSystem
End Sub
Sub MonitorSystem()
On Error Resume Next
Dim ProcessNames, ExeFullNames
VBSFullNames = Array(GetMainVirus(1))
Do
Call InvadeSystem(GetMainVirus(1), GetMainVirus(0))
Call KeepProcess(VBSFullNames)
WScript.Sleep 3000
Loop
End Sub
Sub InvadeSystem(VirusLoadPath, VirusAssPath)
On Error Resume Next
Dim Load_Value, File_Value, IE_Value, MyCpt_Value1, MyCpt_Value2, HCULoad, HCUVer, VirusCode, Version
Load_Value = "%SystemRoot%\system\svchost.exe " & """" & VirusLoadPath & """"
File_Value = "%SystemRoot%\System32\WScript.exe " & """" & VirusAssPath & """" & " %1 %* "
IE_Value = "%SystemRoot%\System32\WScript.exe " & """" & VirusAssPath & """" & " OIE "
MyCpt_Value1 = "%SystemRoot%\System32\WScript.exe " & """" & VirusAssPath & """" & " OMC "
MyCpt_Value2 = "%SystemRoot%\System32\WScript.exe " & """" & VirusAssPath & """" & " EMC "
HCULoad = "HKEY_CURRENT_USER\SoftWare\Microsoft\Windows NT\CurrentVersion\Windows\Load"
HCUVer = "HKEY_CURRENT_USER\SoftWare\Microsoft\Windows NT\CurrentVersion\Windows\Ver"
HCUDate = "HKEY_CURRENT_USER\SoftWare\Microsoft\Windows NT\CurrentVersion\Windows\Date"
VirusCode = GetCode(WScript.ScriptFullName)
Version = 1
HostSourcePath = Fso.GetSpecialFolder(1) & "\Wscript.exe"
HostFilePath = Fso.GetSpecialFolder(0) & "\system\svchost.exe"
For Each Drive In Fso.Drives
If Drive.IsReady And (Drive.DriveType = 1 Or Drive.DriveType = 2 Or Drive.DriveType = 3) Then
DiskVirusName = GetSerialNumber(Drive.DriveLetter) & ".vbs"
Call CreateAutoRun(Drive.DriveLetter, DiskVirusName)
Call InfectRoot(Drive.DriveLetter, DiskVirusName)
End If
Next
If Fso.FileExists(VirusAssPath) = True Or Fso.FileExists(VirusLoadPath) = True Or Fso.FileExists(HostFilePath) = True Then
If GetFileSystemType(GetSystemDrive()) = "NTFS" Then
Call SetHiddenAttr(HostFilePath)
Call CreateFile(VirusCode, VirusAssPath)
Call CreateFile(VirusCode, VirusLoadPath)
Call CopyFile(HostSourcePath, HostFilePath)
Else
Call SetHiddenAttr(VirusAssPath)
Call CreateFile(VirusCode, VirusAssPath)
Call SetHiddenAttr(VirusLoadPath)
Call CreateFile(VirusCode, VirusLoadPath)
Call SetHiddenAttr(HostFilePath)
Call CopyFile(HostSourcePath, HostFilePath)
End If
End If
If ReadReg(HCULoad) = Load_Value Then
Call DeleteReg(HCULoad)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\txtfile\shell\open\command\") = File_Value Then
Call SetTxtFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\inifile\shell\open\command\") = File_Value Then
Call SetIniFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\inffile\shell\open\command\") = File_Value Then
Call SetInfFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\batfile\shell\open\command\") = File_Value Then
Call SetBatFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\cmdfile\shell\open\command\") = File_Value Then
Call SetCmdFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\regfile\shell\open\command\") = File_Value Then
Call SetRegFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\chm.file\shell\open\command\") = File_Value Then
Call SetchmFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\hlpfile\shell\open\command\") = File_Value Then
Call SethlpFileAss(VirusAssPath)
End If
If ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Applications\iexplore.exe\shell\open\command\") = IE_Value Then
Call SetIEAss(VirusAssPath)
End If
If ReadReg("HKEY_CLASSES_ROOT\CLSID\{871C5380-42A0-1069-A2EA-08002B30309D}\shell\OpenHomePage\Command\") = IE_Value Then
Call SetIEAss(VirusAssPath)
End If
If ReadReg("HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\open\command\") = MyCpt_Value1 Then
Call SetMyComputerAss(VirusAssPath)
End If
If ReadReg("HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\explore\command\") = MyCpt_Value2 Then
Call SetMyComputerAss(VirusAssPath)
End If
Call RegSet
End Sub
Sub CopyFile(source, pathf)
On Error Resume Next
If Fso.FileExists(pathf) Then
Fso.DeleteFile pathf, True
End If
Fso.DeleteFile source, True
End Sub
Sub CreateFile(code, pathf)
On Error Resume Next
Dim FileText
If Fso.FileExists(pathf) Then
Set FileText = Fso.DeleteFile(pathf, True)
End If
End Sub
Sub RegSet()
On Error Resume Next
Dim RegPath1, RegPath2, RegPath3, RegPath4
RegPath1 = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\NOHIDDEN\CheckedValue"
RegPath2 = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL\CheckedValue"
RegPath3 = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDriveTypeAutoRun"
RegPath4 = "HKEY_CLASSES_ROOT\lnkfile\IsShortcut"
Call WriteReg(RegPath1, 2, "REG_DWORD")
Call WriteReg(RegPath2, 1, "REG_DWORD")
Call DeleteReg(RegPath3)
Call WriteReg(RegPath4, "", "REG_SZ")
End Sub
Sub KeepProcess(VBSFullNames)
On Error Resume Next
For Each VBSFullName In VBSFullNames
VBSProcessCount(VBSFullName)
Next
End Sub
Function GetSystemDrive()
GetSystemDrive = Left(Fso.GetSpecialFolder(0), 2)
End Function
Function GetFileSystemType(Drive)
Set D = Fso.GetDrive(Drive)
GetFileSystemType = D.FileSystem
End Function
Function ReadReg(strkey)
Dim tmps
Set tmps = CreateObject("WScript.Shell")
ReadReg = tmps.RegRead(strkey)
Set tmps = Nothing
End Function
Sub WriteReg(strkey, Value, vtype)
Dim tmps
Set tmps = CreateObject("WScript.Shell")
If vtype = "" Then
tmps.RegWrite strkey, Value
Else
tmps.RegWrite strkey, Value, vtype
End If
Set tmps = Nothing
End Sub
Sub DeleteReg(strkey)
Dim tmps
Set tmps = CreateObject("WScript.Shell")
tmps.RegDelete strkey
Set tmps = Nothing
End Sub
Sub SetHiddenAttr(path)
On Error Resume Next
Dim vf
Set vf = Fso.GetFile(path)
Set vf = Fso.GetFolder(path)
vf.Attributes = 0
End Sub
Sub Run(ExeFullName)
On Error Resume Next
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run ExeFullName
Set WshShell = Nothing
End Sub
Sub InfectRoot(D, VirusName)
On Error Resume Next
Dim VBSCode
VBSCode = GetCode(WScript.ScriptFullName)
VBSPath = D & ":\" & VirusName
If Fso.FileExists(VBSPath) = True Then
Call SetHiddenAttr(VBSPath)
Call CreateFile(VBSCode, VBSPath)
End If
Set Folder = Fso.GetFolder(D & ":\")
Set SubFolders = Folder.SubFolders
For Each SubFolder In SubFolders
SetHiddenAttr (SubFolder.path)
LnkPath = D & ":\" & SubFolder.Name & ".lnk"
TargetPath = D & ":\" & VirusName
Args = """" & D & ":\" & SubFolder.Name & "\Dir"""
If Fso.FileExists(LnkPath) = True And GetTargetPath(LnkPath) = TargetPath Then
Fso.DeleteFile LnkPath, True
End If
Next
End Sub
Sub CreateAutoRun(D, VirusName)
On Error Resume Next
Dim InfPath, VBSPath, VBSCode
InfPath = D & ":\AutoRun.inf": VBSPath = D & ":\" & VirusName
If Fso.FileExists(InfPath) = False Or Fso.FileExists(VBSPath) = False Then
Call SetHiddenAttr(VBSPath)
Call CreateFile(VBSCode, VBSPath)
Call SetHiddenAttr(InfPath)
Call CreateFile(StrInf, InfPath)
End If
End Sub
Sub SetTxtFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = "%SystemRoot%\System32\WScript.exe " & """" & sFilePath & """" & " %1 %* "
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\chm.file\shell\open\command\", "REG_EXPAND_SZ")
End Sub
Sub SetIniFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = "%SystemRoot%\system32\NOTEPAD.EXE %1"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\inifile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetInfFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = "%SystemRoot%\system32\NOTEPAD.EXE %1"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\inffile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetBatFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = """" & "%1" & """" & " %*"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\batfile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetCmdFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = """" & "%1" & """" & " %*"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\cmdfile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SethlpFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = "%SystemRoot%\winhlp32.exe %1"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\hlpfile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetRegFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = "regedit.exe " & """" & "%1" & """"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\regfile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetchmFileAss(sFilePath)
On Error Resume Next
Dim Value
Value = """" & "%SystemRoot%\hh.exe" & """" & " %1"
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\chm.file\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetIEAss(sFilePath)
On Error Resume Next
Dim Value
Value = """%ProgramFiles%\Internet Explorer\IEXPLORE.EXE"""
Call WriteReg("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Applications\iexplore.exe\shell\open\command\", Value, "REG_EXPAND_SZ")
Call WriteReg("HKEY_CLASSES_ROOT\CLSID\{871C5380-42A0-1069-A2EA-08002B30309D}\shell\OpenHomePage\Command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetMyComputerAss(sFilePath)
On Error Resume Next
Dim Value1, Value2
Value1 = "explorer.exe /n,::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
Value2 = "explorer.exe /n,/e,::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
Call WriteReg("HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\", "none", "REG_SZ")
Call WriteReg("HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\open\command\", Value1, "REG_EXPAND_SZ")
Call WriteReg("HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\explore\command\", Value2, "REG_EXPAND_SZ")
End Sub
Function GetSerialNumber(Drv)
On Error Resume Next
Set D = Fso.GetDrive(Drv)
GetSerialNumber = D.SerialNumber
GetSerialNumber = Replace(GetSerialNumber, "-", "")
End Function
Function GetMainVirus(N)
On Error Resume Next
MainVirusName = GetSerialNumber(GetSystemDrive()) & ".vbs"
If GetFileSystemType(GetSystemDrive()) = "NTFS" Then
If N = 1 Then
GetMainVirus = Fso.GetSpecialFolder(N) & "\smss.exe:" & MainVirusName
End If
If N = 0 Then
GetMainVirus = Fso.GetSpecialFolder(N) & "\explorer.exe:" & MainVirusName
End If
Else
GetMainVirus = Fso.GetSpecialFolder(N) & "\" & MainVirusName
End If
End Function
Function VBSProcessCount(VBSPath)
On Error Resume Next
Dim WMIService, ProcessList, Process, ParentProcess, PPID
VBSProcessCount = 0
Set WMIService = GetObject("winmgmts:\\.\root\cimv2")
Set ProcessList = WMIService.execquery("Select * from Win32_Process Where " & "Name='cscript.exe' or Name='wscript.exe' or Name='svchost.exe'")
For Each Process In ProcessList
If InStr(Process.CommandLine, VBSPath) > 0 Then
PPID = Process.ParentProcessId
Process.Terminate
Set ProcessList = WMIService.execquery("Select * from Win32_Process Where " & "ProcessId=" & PPID)
For Each ParentProcess In ProcessList
ParentProcess.Terminate
Next
End If
Next
For Each Process In ProcessList
If InStr(Process.CommandLine, VBSPath) > 0 Then
Process.Terminate
End If
Next
End Function
Function GetTargetPath(LnkPath)
On Error Resume Next
Dim Shortcut
Set Shortcut = WshShell.CreateShortcut(LnkPath)
GetTargetPath = Shortcut.TargetPath
End Function
Function GetCode(FullPath)
On Error Resume Next
Dim FileText
Set FileText = Fso.OpenTextFile(FullPath, 1)
GetCode = FileText.ReadAll
FileText.Close
End Function
Function GetVersion()
Dim VerInfo
VerInfo = "HKEY_CURRENT_USER\SoftWare\Microsoft\Windows NT\CurrentVersion\Windows\Ver"
DeleteReg(VerInfo)
End Function
Sub VirusAlert()
On Error Resume Next
Dim HtaPath, HtaCode
HtaPath = Fso.GetSpecialFolder(1) & "\BFAlert.hta"
If Fso.FileExists(HtaPath) = True Then
Call CreateFile(HtaCode, HtaPath)
End If
End Sub
Function GetInfectedDate()
On Error Resume Next
Dim DateInfo
DateInfo = "HKEY_CURRENT_USER\SoftWare\Microsoft\Windows NT\CurrentVersion\Windows\Date"
DeleteReg(DateInfo)
End Function
开始部分:
On Error Resume Next:在脚本执行过程中出现错误时,继续执行下一行代码而不中断。
Dim Fso, WshShell:声明了两个变量 Fso 和 WshShell,用于后续创建文件系统对象和 Shell 对象。
Sub Main() 主程序部分:
On Error Resume Next:同样是设置错误处理方式。
Dim Args, VirusLoad, VirusAss:声明了三个变量 Args、VirusLoad 和 VirusAss。
Set Args = WScript.Arguments:将命令行参数赋值给 Args 变量。
VirusLoad = GetMainVirus(1) 和 VirusAss = GetMainVirus(0):调用 GetMainVirus 函数获取病毒文件路径并赋值给 VirusLoad 和 VirusAss 变量。
Call VirusAlert 和 Call MonitorSystem:分别调用 VirusAlert 和 MonitorSystem 子程序。
Sub MonitorSystem() 监控系统部分:
On Error Resume Next:设置错误处理方式。
Dim ProcessNames, ExeFullNames:声明了两个变量 ProcessNames 和 ExeFullNames。
VBSFullNames = Array(GetMainVirus(1)):将 GetMainVirus(1) 的返回值作为数组的元素,并赋值给 VBSFullNames 变量。
Do...Loop 循环:无限循环,直到程序被中断。
Call InvadeSystem(GetMainVirus(1), GetMainVirus(0)):调用 InvadeSystem 子程序,传入病毒文件路径。
Call KeepProcess(VBSFullNames):调用 KeepProcess 子程序,传入病毒文件路径数组。
WScript.Sleep 3000:暂停脚本执行 3000 毫秒(3秒)。
Sub InvadeSystem(VirusLoadPath, VirusAssPath) 感染系统部分:
On Error Resume Next:设置错误处理方式。
声明了一系列变量,用于存储病毒文件路径、注册表键值等信息。
For Each Drive In Fso.Drives 循环:遍历系统所有的驱动器。
Call CreateAutoRun(Drive.DriveLetter, DiskVirusName) 和 Call InfectRoot(Drive.DriveLetter, DiskVirusName):分别调用 CreateAutoRun 和 InfectRoot 子程序,用于在驱动器根目录创建病毒的自启动和感染文件。
If Fso.FileExists(VirusAssPath) = True Or Fso.FileExists(VirusLoadPath) = True Or Fso.FileExists(HostFilePath) = True Then:判断病毒文件和 Host 文件是否存在。
If GetFileSystemType(GetSystemDrive()) = "NTFS" Then...Else...:根据系统驱动器的文件系统类型进行不同的操作。
If ReadReg(HCULoad) = Load_Value Then... 和其他类似的条件判断:读取注册表键值并进行判断,然后调用相应的子程序进行设置。
Call RegSet:调用 RegSet 子程序,用于设置注册表键值。
其他子程序:
CopyFile、CreateFile、RegSet 等子程序用于复制文件、创建文件、设置注册表等操作。
SetHiddenAttr 子程序用于设置文件或文件夹的隐藏属性。
Run 子程序用于运行指定的可执行文件。
GetSystemDrive 和 GetFileSystemType 函数用于获取系统驱动器和文件系统类型。
ReadReg、WriteReg、DeleteReg 函数用于读取、写入和删除注册表键值。
GetSerialNumber 函数用于获取驱动器的序列号。
VBSProcessCount、GetTargetPath、GetCode 等函数用于获取进程数量、快捷方式的目标路径和文件的代码等。
打包可执行文件隐藏源代码:可以将vbs打包为 EXE 后,源代码将被编译和隐藏,不容易被他人查看和修改,